SystemOrganization addCategory: #'Filesystem-Core'! SystemOrganization addCategory: #'Filesystem-Streams'! SystemOrganization addCategory: #'Filesystem-Resolvers'! SystemOrganization addCategory: #'Filesystem-Enumeration'! SystemOrganization addCategory: #'Filesystem-Exceptions'! SystemOrganization addCategory: #'Filesystem-Disk'! SystemOrganization addCategory: #'Filesystem-Memory'! SystemOrganization addCategory: #'Filesystem-Zip'! SystemOrganization addCategory: #'Filesystem-Release'! SystemOrganization addCategory: #'Filesystem-Tests'! SystemOrganization addCategory: #'Filesystem-Public'! RWBinaryOrTextStream subclass: #FSFileStream instanceVariableNames: 'store path' classVariableNames: '' poolDictionaries: '' category: 'Filesystem-Streams'! !FSFileStream commentStamp: 'cwp 11/18/2009 11:24' prior: 0! I am an abstract superclass for classes that provide FileStream-compatible streams, for using alternate filesystems from legacy code.! !FSFileStream class methodsFor: 'instance creation' stamp: 'cwp 2/19/2011 01:17'! on: aCollection store: aStore path: aPath ^ (self on: aCollection) setStore: aStore path: aPath; yourself! ! !FSFileStream methodsFor: 'private' stamp: 'DamienPollet 2/5/2011 00:58'! on: aCollection super on: aCollection. readLimit := collection size.! ! !FSFileStream methodsFor: 'accessing' stamp: 'cwp 2/19/2011 01:18'! setStore: aStore path: aPath store := aStore. path := aPath.! ! FSFileStream subclass: #FSMemoryFileStream instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Filesystem-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! ! Error subclass: #FSFilesystemError instanceVariableNames: 'reference' classVariableNames: '' poolDictionaries: '' category: 'Filesystem-Exceptions'! !FSFilesystemError commentStamp: 'cwp 11/18/2009 12:32' prior: 0! I am an abstract superclass for errors that may occur during filesystem operations.! FSFilesystemError subclass: #FSDirectoryDoesNotExist instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Filesystem-Exceptions'! !FSDirectoryDoesNotExist commentStamp: 'cwp 11/18/2009 12:33' prior: 0! I am raised when I an operation is attempted inside a directory that does not exist. ! FSFilesystemError subclass: #FSDirectoryExists instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Filesystem-Exceptions'! !FSDirectoryExists commentStamp: 'cwp 11/18/2009 12:35' prior: 0! I am raised on an attempt to create a directory that already exists.! FSFilesystemError subclass: #FSFileDoesNotExist instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Filesystem-Exceptions'! !FSFileDoesNotExist commentStamp: 'cwp 11/18/2009 12:35' prior: 0! I am raised when an operation is attempted on a file that does not exist. This includes cases where a file operation is attempted on a directory.! FSFilesystemError subclass: #FSFileExists instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Filesystem-Exceptions'! !FSFileExists commentStamp: 'cwp 11/18/2009 12:37' prior: 0! I am raised on an attempt to create a file or directory over top of an existing file.! !FSFilesystemError class methodsFor: 'instance creation' stamp: 'cwp 11/14/2009 23:32'! reference: aReference ^ self basicNew initializeWithReference: aReference! ! !FSFilesystemError class methodsFor: 'instance creation' stamp: 'cwp 11/14/2009 23:31'! signalWith: aReference ^ (self reference: aReference) signal! ! !FSFilesystemError methodsFor: 'initialize-release' stamp: 'lr 8/16/2010 16:00'! initializeWithReference: aReference reference := aReference. messageText := aReference printString! ! !FSFilesystemError methodsFor: 'testing' stamp: 'lr 8/16/2010 16:00'! isResumable ^ true! ! !FSFilesystemError methodsFor: 'accessing' stamp: 'lr 7/13/2010 15:31'! reference ^ reference! ! FSFilesystemError subclass: #FSIllegalName instanceVariableNames: 'name' classVariableNames: '' poolDictionaries: '' category: 'Filesystem-Public'! !FSIllegalName classSide methodsFor: 'instance creation' stamp: 'DamienPollet 2/28/2011 17:04'! name: aName ^ self basicNew initializeWithName: aName! ! !FSIllegalName classSide methodsFor: 'instance creation' stamp: 'DamienPollet 2/28/2011 17:03'! signalWith: aName ^ (self name: aName) signal! ! !FSIllegalName methodsFor: 'initialization' stamp: 'DamienPollet 2/28/2011 17:08'! initializeWithName: aName name := aName. self messageText: aName! ! !FSIllegalName methodsFor: 'accessing' stamp: 'DamienPollet 2/28/2011 17:08'! name ^ name! ! !String methodsFor: '*filesystem-converting' stamp: 'cwp 11/21/2009 11:30'! asPathWith: anObject ^ anObject pathFromString: self! ! !String methodsFor: '*filesystem-converting' stamp: 'StephaneDucasse 2/9/2011 13:41'! asResolvedBy: aFileSystem ^ aFileSystem resolveString: self! ! Notification subclass: #FSResolutionRequest instanceVariableNames: 'origin' classVariableNames: '' poolDictionaries: '' category: 'Filesystem-Resolvers'! !FSResolutionRequest commentStamp: 'cwp 11/18/2009 11:38' prior: 0! I represent a request for user assistance in resolving an origin. I am a resumable exception that gets raised when there is no way of automatically resolving a particular origin. ! !FSResolutionRequest class methodsFor: 'instance creation' stamp: 'cwp 10/27/2009 10:13'! for: origin ^ self new origin: origin; signal! ! !FSResolutionRequest methodsFor: 'exceptionDescription' stamp: 'cwp 2/19/2011 15:09'! defaultAction | filedir ref | filedir := UIManager default chooseDirectory: 'Where is ', origin, '?'. ref := filedir ifNotNil: [FSFilesystem onDisk referenceTo: filedir fullName]. self resume: ref! ! !FSResolutionRequest methodsFor: 'accessing' stamp: 'cwp 10/27/2009 10:22'! origin: aSymbol origin := aSymbol! ! TestCase subclass: #FSDirectoryEntryTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Filesystem-Tests'! !FSDirectoryEntryTest methodsFor: 'accessing' stamp: 'cwp 2/18/2011 17:04'! entry ^ FSLocator image resolve entry! ! !FSDirectoryEntryTest methodsFor: 'tests' stamp: 'StephaneDucasse 1/27/2011 22:26'! testCreationTimeIsADateAndTimeInstance "While creation is the message sent to a directory entry, creation returns a DateAndTime object" | creation | creation := self entry creation. self assert: creation class = DateAndTime. ! ! !FSDirectoryEntryTest methodsFor: 'tests' stamp: 'cwp 2/18/2011 16:57'! testIsDirectory | ref entry | ref := FSLocator imageDirectory resolve. entry := ref entry. self assert: entry isDirectory! ! !FSDirectoryEntryTest methodsFor: 'tests' stamp: 'StephaneDucasse 1/27/2011 22:26'! testIsFile self assert: self entry isFile. self deny: self entry isDirectory! ! !FSDirectoryEntryTest methodsFor: 'tests' stamp: 'cwp 11/15/2009 22:10'! testIsNotDirectory self deny: self entry isDirectory! ! !FSDirectoryEntryTest methodsFor: 'tests' stamp: 'cwp 2/18/2011 17:01'! testIsNotFile | ref | ref := FSLocator imageDirectory resolve. self deny: ref entry isFile! ! !FSDirectoryEntryTest methodsFor: 'tests' stamp: 'StephaneDucasse 1/27/2011 22:27'! testModificationTimeIsADateAndTimeInstance "While modification is the message sent to a directory entry, modification returns a DateAndTime object" | modification | modification := self entry modification. self assert: modification class = DateAndTime. ! ! !FSDirectoryEntryTest methodsFor: 'tests' stamp: 'cwp 2/18/2011 17:05'! testReference | ref entry | ref := FSLocator image resolve. entry := ref entry. self assert: entry reference = ref! ! !FSDirectoryEntryTest methodsFor: 'tests' stamp: 'cwp 11/15/2009 22:05'! testSize self assert: self entry size isInteger! ! TestCase subclass: #FSFilesystemTest instanceVariableNames: 'filesystem toDelete' classVariableNames: '' poolDictionaries: '' category: 'Filesystem-Tests'! FSFilesystemTest subclass: #FSDiskFilesystemTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Filesystem-Tests'! !FSDiskFilesystemTest methodsFor: 'initialize-release' stamp: 'cwp 2/18/2011 22:59'! createFilesystem ^ FSFilesystem store: (FSDiskStore activeClass createDefault)! ! !FSDiskFilesystemTest methodsFor: 'tests' stamp: 'cwp 10/11/2009 22:23'! testDefaultWorkingDirectory | ref | ref := filesystem referenceTo: filesystem workingDirectory. self assert: (SmalltalkImage current imagePath beginsWith: ref asString)! ! !FSDiskFilesystemTest methodsFor: 'tests' stamp: 'cwp 7/24/2009 00:40'! testEqual | other | other := self createFilesystem. self assert: filesystem = other! ! !FSDiskFilesystemTest methodsFor: 'tests' stamp: 'cwp 2/18/2011 17:01'! testIsDirectory self assert: (filesystem isDirectory: FSLocator imageDirectory resolve path)! ! !FSFilesystemTest class methodsFor: 'testing' stamp: 'cwp 7/20/2009 08:56'! isAbstract ^ self name = #FSFilesystemTest! ! !FSFilesystemTest class methodsFor: 'accessing' stamp: 'lr 7/13/2010 14:01'! packageNamesUnderTest ^ #('Filesystem')! ! !FSFilesystemTest class methodsFor: 'testing' stamp: 'cwp 7/20/2009 08:56'! shouldInheritSelectors ^ true ! ! !FSFilesystemTest methodsFor: 'initialize-release' stamp: 'cwp 7/20/2009 07:31'! createFilesystem self subclassResponsibility ! ! !FSFilesystemTest methodsFor: 'initialize-release' stamp: 'cwp 10/10/2009 17:35'! delete: anObject toDelete add: (filesystem resolve: anObject)! ! !FSFilesystemTest methodsFor: 'initialize-release' stamp: 'cwp 8/23/2009 23:10'! setUp filesystem := self createFilesystem. toDelete := OrderedCollection new.! ! !FSFilesystemTest methodsFor: 'initialize-release' stamp: 'cwp 8/23/2009 23:09'! tearDown toDelete do: [:path | filesystem delete: path]! ! !FSFilesystemTest methodsFor: 'tests' stamp: 'cwp 3/29/2011 16:34'! testChangeDirectory | cwd | filesystem workingDirectoryPath: FSPath / 'plonk'. filesystem changeDirectory: 'griffle'. cwd := filesystem workingDirectoryPath. self assert: cwd isAbsolute. self assert: (cwd at: 1) = 'plonk'. self assert: (cwd at: 2) = 'griffle'. ! ! !FSFilesystemTest methodsFor: 'tests' stamp: 'cwp 3/29/2011 16:34'! testChangeDirectoryString | cwd | filesystem workingDirectoryPath: (FSPath / 'plonk'). filesystem changeDirectory: 'griffle'. cwd := filesystem workingDirectoryPath. self assert: cwd isAbsolute. self assert: (cwd at: 1) = 'plonk'. self assert: (cwd at: 2) = 'griffle'! ! !FSFilesystemTest methodsFor: 'tests' stamp: 'cwp 2/26/2011 18:19'! testChildrenAt | directory entries | directory := FSPath * 'plonk'. filesystem createDirectory: directory. filesystem createDirectory: directory / 'griffle'. filesystem createDirectory: directory / 'bint'. self delete: directory / 'griffle'. self delete: directory / 'bint'. self delete: directory. entries := filesystem childrenAt: directory. self assert: entries size = 2. entries do: [ :ea | self assert: (ea isKindOf: FSPath). self assert: ea parent = (filesystem resolve: directory). self assert: (#('griffle' 'bint' ) includes: ea basename) ]! ! !FSFilesystemTest methodsFor: 'tests' stamp: 'lr 7/13/2010 15:19'! testCopy | out in contents | [ out := filesystem writeStreamOn: 'gooly'. [ out nextPutAll: 'gooly' ] ensure: [ out close ]. filesystem copy: 'gooly' to: 'plonk'. in := filesystem readStreamOn: 'plonk'. contents := [ in contents asString ] ensure: [ in close ]. self assert: contents = 'gooly' ] ensure: [ filesystem delete: 'gooly'; delete: 'plonk' ]! ! !FSFilesystemTest methodsFor: 'tests' stamp: 'cwp 11/14/2009 23:37'! testCopyDestExists | out | [out := (filesystem open: 'gooly' writable: true) writeStream. [out nextPutAll: 'gooly'] ensure: [out close]. out := filesystem open: 'plonk' writable: true. out close. self should: [filesystem copy: 'gooly' to: 'plonk'] raise: FSFileExists] ensure: [filesystem delete: 'gooly'; delete: 'plonk']! ! !FSFilesystemTest methodsFor: 'tests' stamp: 'cwp 11/14/2009 23:36'! testCopySourceDoesntExist self should: [filesystem copy: 'plonk' to: 'griffle'] raise: FSFileDoesNotExist! ! !FSFilesystemTest methodsFor: 'tests' stamp: 'cwp 11/17/2009 16:56'! testCreateDirectoryExists | path | path := FSPath * 'griffle'. self delete: path. filesystem createDirectory: path. self should: [filesystem createDirectory: path] raise: FSDirectoryExists. ! ! !FSFilesystemTest methodsFor: 'tests' stamp: 'cwp 11/17/2009 16:53'! testCreateDirectoryNoParent | path | path := FSPath * 'griffle' / 'nurp'. self should: [filesystem createDirectory: path] raise: FSDirectoryDoesNotExist. ! ! !FSFilesystemTest methodsFor: 'tests' stamp: 'cwp 7/20/2009 07:30'! testDefaultWorkingDirectory self assert: filesystem workingDirectory isRoot! ! !FSFilesystemTest methodsFor: 'tests' stamp: 'cwp 7/20/2009 07:30'! testDelimiter self assert: filesystem delimiter isCharacter! ! !FSFilesystemTest methodsFor: 'tests' stamp: 'cwp 2/26/2011 18:19'! testDirectory | path | path := FSPath * 'plonk'. filesystem createDirectory: path. self assert: (filesystem exists: path). self assert: (filesystem isDirectory: path). self deny: (filesystem isFile: path). filesystem delete: path. self deny: (filesystem exists: path)! ! !FSFilesystemTest methodsFor: 'tests' stamp: 'lr 7/13/2010 16:19'! testEnsureDirectory | path | path := FSPath * 'plonk'. self delete: path. filesystem ensureDirectory: path. self assert: (filesystem isDirectory: path).! ! !FSFilesystemTest methodsFor: 'tests' stamp: 'lr 7/13/2010 16:20'! testEnsureDirectoryCreatesParent | path | path := FSPath * 'plonk' / 'griffle'. self delete: path. self delete: path parent. self shouldnt: [filesystem ensureDirectory: path] raise: FSFilesystemError. self assert: (filesystem isDirectory: (FSPath * 'plonk')). self assert: (filesystem isDirectory: path). ! ! !FSFilesystemTest methodsFor: 'tests' stamp: 'lr 7/13/2010 16:19'! testEnsureDirectoryExists | path | path := FSPath * 'plonk'. self delete: path. filesystem createDirectory: path. self shouldnt: [filesystem ensureDirectory: path] raise: FSFilesystemError. ! ! !FSFilesystemTest methodsFor: 'tests' stamp: 'cwp 2/26/2011 18:19'! testEntriesAt | directory entries | directory := FSPath * 'plonk'. filesystem createDirectory: directory. filesystem createDirectory: directory / 'griffle'. filesystem createDirectory: directory / 'bint'. self delete: directory / 'griffle'. self delete: directory / 'bint'. self delete: directory. entries := filesystem entriesAt: directory. self assert: entries size = 2. entries do: [ :ea | self assert: (ea isKindOf: FSDirectoryEntry). self assert: ea reference parent path = (filesystem resolve: directory). self assert: (#('griffle' 'bint' ) includes: ea reference basename). self assert: ea isDirectory ]! ! !FSFilesystemTest methodsFor: 'tests' stamp: 'cwp 11/16/2009 00:21'! testEntryAt | path entry | path := FSPath * 'plonk'. filesystem createDirectory: path. self delete: path. entry := filesystem entryAt: path. self assert: entry isDirectory. self assert: entry reference = (filesystem referenceTo: path) asAbsolute! ! !FSFilesystemTest methodsFor: 'tests' stamp: 'cwp 2/26/2011 18:19'! testFile | path out | path := FSPath * 'gooly'. out := filesystem open: path writable: true. out close. self assert: (filesystem exists: path). self deny: (filesystem isDirectory: path). self assert: (filesystem isFile: path). filesystem delete: path. self deny: (filesystem exists: path)! ! !FSFilesystemTest methodsFor: 'tests' stamp: 'sd 2/11/2011 18:21'! testFileNames | reference | #('test one' 'test with two' 'test-äöü' 'test.äöü') do: [ :each | reference := filesystem workingDirectory / each. self assert: reference basename = each. self deny: reference exists. reference writeStreamDo: [ :stream | stream nextPutAll: 'gooly' ] ifPresent: [ self fail ]. [ self assert: reference exists. self assert: (filesystem workingDirectory children anySatisfy: [ :ref | ref = reference ]) ] ensure: [ reference delete ] ]! ! !FSFilesystemTest methodsFor: 'tests-references' stamp: 'sd 2/11/2011 18:21'! testFileStreamDo | reference | self delete: (reference := filesystem workingDirectory / 'griffle'). self assert: (reference fileStreamDo: [ :stream | stream nextPutAll: 'griffle'. true ]). self assert: (filesystem workingDirectory / 'griffle') isFile. self assert: (reference fileStreamDo: [ :stream | true ])! ! !FSFilesystemTest methodsFor: 'tests-references' stamp: 'sd 2/11/2011 18:21'! testReadStream | reference stream | self delete: (reference := filesystem workingDirectory / 'griffle'). self should: [ reference readStream ] raise: FSFileDoesNotExist. reference writeStreamDo: [ :ws | ws nextPutAll: 'griffle' ]. self shouldnt: [ stream := reference readStream ] raise: FSFileDoesNotExist. self assert: stream contents asString = 'griffle'. stream close! ! !FSFilesystemTest methodsFor: 'tests-references' stamp: 'sd 2/11/2011 18:21'! testReadStreamDo | reference | self delete: (reference := filesystem workingDirectory / 'griffle'). self should: [ reference readStreamDo: [ :stream | self assert: false ] ] raise: FSFileDoesNotExist. reference writeStreamDo: [ :ws | ws nextPutAll: 'griffle' ]. self assert: (reference readStreamDo: [ :stream | stream contents asString ]) = 'griffle'! ! !FSFilesystemTest methodsFor: 'tests-references' stamp: 'sd 2/11/2011 18:21'! testReadStreamDoIfAbsent | reference | self delete: (reference := filesystem workingDirectory / 'griffle'). self assert: (reference readStreamDo: [ :stream | false ] ifAbsent: [ true ]). reference writeStreamDo: [ :ws | ws nextPutAll: 'griffle' ]. self assert: (reference readStreamDo: [ :stream | stream contents asString = 'griffle' ] ifAbsent: [ false ])! ! !FSFilesystemTest methodsFor: 'tests-references' stamp: 'sd 2/11/2011 18:21'! testReadStreamIfAbsent | reference stream | self delete: (reference := filesystem workingDirectory / 'griffle'). self assert: (reference readStreamIfAbsent: [ true ]). reference writeStreamDo: [ :ws | ws nextPutAll: 'griffle' ]. stream := reference readStreamIfAbsent: [ false ]. self assert: stream contents asString = 'griffle'. stream close! ! !FSFilesystemTest methodsFor: 'tests' stamp: 'lr 2/14/2010 09:49'! testRoot self assert: filesystem root filesystem = filesystem. self assert: filesystem root path = FSPath root! ! !FSFilesystemTest methodsFor: 'tests' stamp: 'cwp 10/10/2009 00:33'! testRootExists self assert: (filesystem exists: FSPath root)! ! !FSFilesystemTest methodsFor: 'tests' stamp: 'cwp 10/10/2009 00:25'! testRootIsDirectory self assert: (filesystem isDirectory: FSPath root)! ! !FSFilesystemTest methodsFor: 'tests' stamp: 'cwp 10/10/2009 00:33'! testRootIsNotAFile self deny: (filesystem isFile: FSPath root)! ! !FSFilesystemTest methodsFor: 'tests' stamp: 'cwp 3/29/2011 15:58'! testSetRelativeWorkingDirectory self should: [filesystem workingDirectoryPath: (FSPath * 'plonk')] raise: Error ! ! !FSFilesystemTest methodsFor: 'tests' stamp: 'cwp 3/29/2011 16:35'! testSetWorkingDirectory | cwd | filesystem workingDirectoryPath: (FSPath / 'plonk'). cwd := filesystem workingDirectoryPath. self assert: cwd isAbsolute. self assert: (cwd at: 1) = 'plonk'! ! !FSFilesystemTest methodsFor: 'tests' stamp: 'sd 2/11/2011 18:21'! testWorking self assert: filesystem workingDirectory filesystem = filesystem. self assert: filesystem workingDirectory path = filesystem workingDirectoryPath! ! !FSFilesystemTest methodsFor: 'tests-references' stamp: 'sd 2/11/2011 18:21'! testWriteStream | reference stream | self delete: (reference := filesystem workingDirectory / 'griffle'). stream := reference writeStream. stream nextPutAll: 'griffle'. stream close. self assert: (filesystem workingDirectory / 'griffle') isFile. stream := reference writeStream. stream close! ! !FSFilesystemTest methodsFor: 'tests-references' stamp: 'sd 2/11/2011 18:21'! testWriteStreamDo | reference | self delete: (reference := filesystem workingDirectory / 'griffle'). self assert: (reference writeStreamDo: [ :stream | stream nextPutAll: 'griffle'. true ]). self assert: (filesystem workingDirectory / 'griffle') isFile. self assert: (reference writeStreamDo: [ :stream | true ])! ! !FSFilesystemTest methodsFor: 'tests-references' stamp: 'sd 2/11/2011 18:21'! testWriteStreamDoIfPresent | reference | self delete: (reference := filesystem workingDirectory / 'griffle'). self assert: (reference writeStreamDo: [ :stream | stream nextPutAll: 'griffle'. true ] ifPresent: [ false ]). self assert: (filesystem workingDirectory / 'griffle') isFile. self assert: (reference writeStreamDo: [ :stream | true ] ifPresent: [ true ])! ! !FSFilesystemTest methodsFor: 'tests-references' stamp: 'sd 2/11/2011 18:21'! testWriteStreamIfPresent | reference stream | self delete: (reference := filesystem workingDirectory / 'griffle'). stream := reference writeStreamIfPresent: [ false ]. stream nextPutAll: 'griffle'. stream close. self assert: (filesystem workingDirectory / 'griffle') isFile. self assert: (reference writeStreamIfPresent: [ true ])! ! FSFilesystemTest subclass: #FSMemoryFilesystemTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Filesystem-Tests'! !FSMemoryFilesystemTest methodsFor: 'initialize-release' stamp: 'cwp 2/19/2011 01:26'! createFilesystem ^ FSFilesystem inMemory! ! !FSMemoryFilesystemTest methodsFor: 'tests' stamp: 'cwp 7/24/2009 00:41'! testEqual | other | other := self createFilesystem. self deny: filesystem = other! ! FSFilesystemTest subclass: #FSZipFilesystemTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Filesystem-Tests'! !FSZipFilesystemTest methodsFor: 'initialize-release' stamp: 'cwp 2/19/2011 14:45'! createFilesystem | ref | ref := FSFilesystem inMemory referenceTo: 'fs.zip'. ^ (FSFilesystem inZip: ref) open; yourself! ! !FSZipFilesystemTest methodsFor: 'tests' stamp: 'cwp 2/19/2011 14:44'! testOpenArchive | memory archive | memory := FSFilesystem inMemory. memory root / 'fs.zip' writeStreamDo: [ :stream | stream nextPutAll: #[80 75 3 4 10 0 2 0 0 0 152 90 84 60 227 229 149 176 12 0 0 0 12 0 0 0 7 0 28 0 103 114 105 102 102 108 101 85 84 9 0 3 128 183 127 75 114 183 127 75 117 120 11 0 1 4 245 1 0 0 4 20 0 0 0 72 101 108 108 111 32 87 111 114 108 100 10 80 75 1 2 30 3 10 0 2 0 0 0 152 90 84 60 227 229 149 176 12 0 0 0 12 0 0 0 7 0 24 0 0 0 0 0 1 0 0 0 164 129 0 0 0 0 103 114 105 102 102 108 101 85 84 5 0 3 128 183 127 75 117 120 11 0 1 4 245 1 0 0 4 20 0 0 0 80 75 5 6 0 0 0 0 1 0 1 0 77 0 0 0 77 0 0 0 0 0] ]. archive := FSFilesystem inZip: memory root / 'fs.zip'. archive open. self assert: (archive root children size = 1). self assert: (archive root / 'griffle') exists. self assert: (archive root / 'griffle') readStream contents = #[72 101 108 108 111 32 87 111 114 108 100 10]! ! !FSZipFilesystemTest methodsFor: 'tests' stamp: 'cwp 2/19/2011 14:44'! testWriteArchive | memory archive | memory := FSFilesystem inMemory. archive := FSFilesystem inZip: memory root / 'fs.zip'. archive open. (archive root / 'griffle') writeStreamDo: [ :stream | stream nextPutAll: 'Hello World' ]. archive close. self assert: (memory root / 'fs.zip') exists. self assert: (memory root / 'fs.zip') entry size > 0! ! TestCase subclass: #FSHandleTest instanceVariableNames: 'filesystem handle reference' classVariableNames: '' poolDictionaries: '' category: 'Filesystem-Tests'! FSHandleTest subclass: #FSFileHandleTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Filesystem-Tests'! !FSFileHandleTest methodsFor: 'running' stamp: 'cwp 2/18/2011 23:03'! createFilesystem ^ FSFilesystem store: FSDiskStore activeClass createDefault! ! !FSHandleTest class methodsFor: 'testing' stamp: 'cwp 7/26/2009 12:46'! isAbstract ^ self name = #FSHandleTest! ! !FSHandleTest class methodsFor: 'testing' stamp: 'cwp 7/26/2009 12:46'! shouldInheritSelectors ^ true! ! !FSHandleTest methodsFor: 'running' stamp: 'cwp 11/18/2009 10:23'! createFilesystem self subclassResponsibility ! ! !FSHandleTest methodsFor: 'running' stamp: 'cwp 7/26/2009 12:22'! setUp filesystem := self createFilesystem. reference := filesystem referenceTo: 'plonk'. handle := reference openWritable: true! ! !FSHandleTest methodsFor: 'running' stamp: 'cwp 7/26/2009 12:23'! tearDown handle close. reference delete! ! !FSHandleTest methodsFor: 'tests' stamp: 'cwp 7/29/2009 22:06'! testAt handle at: 1 write: (ByteArray with: 3) startingAt: 1 count: 1. self assert: (handle at: 1) = 3! ! !FSHandleTest methodsFor: 'tests' stamp: 'cwp 7/29/2009 22:03'! testAtPut | in | handle at: 1 put: 3. in := ByteArray new: 1. handle at: 1 read: in startingAt: 1 count: 1. self assert: in first = 3! ! !FSHandleTest methodsFor: 'tests' stamp: 'lr 4/13/2010 16:10'! testAtPutBinaryAscii self shouldnt: [ handle at: 1 put: 32 ] raise: Error. self shouldnt: [ handle at: 1 put: Character space ] raise: Error! ! !FSHandleTest methodsFor: 'tests' stamp: 'lr 4/13/2010 16:07'! testAtWriteBinaryAscii self shouldnt: [ handle at: 1 write: #[32] startingAt: 1 count: 1 ] raise: Error. self shouldnt: [ handle at: 1 write: (String with: Character space) startingAt: 1 count: 1 ] raise: Error! ! !FSHandleTest methodsFor: 'tests' stamp: 'cwp 7/26/2009 12:23'! testClose handle close. self deny: handle isOpen ! ! !FSHandleTest methodsFor: 'tests' stamp: 'cwp 7/26/2009 12:23'! testCreatedOpen self assert: handle isOpen! ! !FSHandleTest methodsFor: 'tests' stamp: 'cwp 7/26/2009 14:15'! testIO | out in | out := #(1 2 3) asByteArray. in := ByteArray new: 3. handle at: 1 write: out startingAt: 1 count: 3. handle at: 1 read: in startingAt: 1 count: 3. self assert: out = in.! ! !FSHandleTest methodsFor: 'tests' stamp: 'cwp 7/31/2009 00:13'! testReadBufferTooLarge | out in result | out := #(1 2 3) asByteArray. in := ByteArray new: 5. in atAllPut: 9. handle at: 1 write: out startingAt: 1 count: 3. result := handle at: 1 read: in startingAt: 2 count: 4. self assert: result = 3. self assert: in = #(9 1 2 3 9) asByteArray.! ! !FSHandleTest methodsFor: 'tests' stamp: 'cwp 7/26/2009 14:16'! testReadOnly handle close. handle := reference openWritable: false. self should: [ handle at: 1 write: #(1 2 3 ) startingAt: 1 count: 3 ] raise: Error! ! !FSHandleTest methodsFor: 'tests' stamp: 'cwp 7/26/2009 12:45'! testReference self assert: handle reference = reference asAbsolute! ! !FSHandleTest methodsFor: 'tests' stamp: 'cwp 7/29/2009 22:11'! testSizeAfterGrow | out | out := #(1 2 3) asByteArray. handle at: 1 write: out startingAt: 1 count: 3. self assert: handle size = 3! ! !FSHandleTest methodsFor: 'tests' stamp: 'cwp 7/29/2009 22:13'! testSizeNoGrow | bytes | bytes := #(1 2 3 4) asByteArray. handle at: 1 write: bytes startingAt: 1 count: 3. handle at: 4 write: bytes startingAt: 4 count: 1. self assert: handle size = 4! ! !FSHandleTest methodsFor: 'tests' stamp: 'cwp 7/26/2009 14:16'! testTruncate | out | out := #(1 2 3 4 5) asByteArray. handle at: 1 write: out startingAt: 1 count: 5. handle truncateTo: 3. self assert: handle size = 3! ! !FSHandleTest methodsFor: 'tests' stamp: 'cwp 7/28/2009 22:40'! testWriteStream | stream | stream := handle writeStream. self assert: (stream respondsTo: #nextPut:)! ! FSHandleTest subclass: #FSMemoryHandleTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Filesystem-Tests'! !FSMemoryHandleTest methodsFor: 'running' stamp: 'cwp 2/19/2011 01:26'! createFilesystem ^ FSFilesystem inMemory! ! TestCase subclass: #FSLocatorTest instanceVariableNames: 'locator' classVariableNames: '' poolDictionaries: '' category: 'Filesystem-Tests'! !FSLocatorTest methodsFor: 'compatibility tests' stamp: 'lr 7/13/2010 15:18'! testAsAbsolute locator := FSLocator image. self assert: locator asAbsolute = locator! ! !FSLocatorTest methodsFor: 'compatibility tests' stamp: 'lr 7/13/2010 15:18'! testBasename locator := FSLocator image / 'griffle'. self assert: locator basename = 'griffle'! ! !FSLocatorTest methodsFor: 'compatibility tests' stamp: 'lr 7/13/2010 15:18'! testCommaAddsExtension locator := FSLocator image / 'griffle'. self assert: (locator , 'plonk') basename = 'griffle.plonk'! ! !FSLocatorTest methodsFor: 'compatibility tests' stamp: 'lr 7/13/2010 15:18'! testCommaAddsExtensionAgain locator := FSLocator image / 'griffle.plonk'. self assert: (locator , 'nurp') basename = 'griffle.plonk.nurp'! ! !FSLocatorTest methodsFor: 'compatibility tests' stamp: 'cwp 10/25/2009 22:24'! testContainsLocator locator := FSLocator image. self assert: (locator contains: locator / 'griffle').! ! !FSLocatorTest methodsFor: 'compatibility tests' stamp: 'sd 2/11/2011 20:04'! testContainsPath "self debug: #testContainsPath" locator := FSLocator image. self assert: (locator contains: (locator resolve / 'griffle') path).! ! !FSLocatorTest methodsFor: 'compatibility tests' stamp: 'cwp 10/25/2009 22:40'! testContainsReference locator := FSLocator image. self assert: (locator contains: (locator resolve / 'griffle')).! ! !FSLocatorTest methodsFor: 'compatibility tests' stamp: 'cwp 10/25/2009 11:14'! testEqual | a b | a := FSLocator image. b := FSLocator image. self deny: a == b. self assert: a = b.! ! !FSLocatorTest methodsFor: 'compatibility tests' stamp: 'cwp 2/18/2011 23:07'! testFilesystem locator := FSLocator image. self assert: (locator filesystem isKindOf: FSFilesystem)! ! !FSLocatorTest methodsFor: 'resolution tests' stamp: 'cwp 2/18/2011 17:05'! testImageDirectory locator := FSLocator image. self assert: locator resolve = FSLocator image resolve! ! !FSLocatorTest methodsFor: 'compatibility tests' stamp: 'lr 7/13/2010 15:18'! testIsAbsolute locator := FSLocator image. self assert: locator isAbsolute! ! !FSLocatorTest methodsFor: 'compatibility tests' stamp: 'cwp 10/25/2009 11:17'! testIsNotRoot locator := FSLocator image. self deny: locator isRoot! ! !FSLocatorTest methodsFor: 'compatibility tests' stamp: 'lr 7/13/2010 15:18'! testIsRelative locator := FSLocator image. self deny: locator isRelative! ! !FSLocatorTest methodsFor: 'compatibility tests' stamp: 'cwp 2/26/2011 18:20'! testIsRoot locator := FSLocator image. (locator resolve path size) timesRepeat: [locator := locator / '..']. self assert: locator isRoot! ! !FSLocatorTest methodsFor: 'compatibility tests' stamp: 'cwp 2/18/2011 17:05'! testOriginBasename locator := FSLocator image. self assert: locator basename = FSLocator image resolve basename! ! !FSLocatorTest methodsFor: 'compatibility tests' stamp: 'cwp 2/18/2011 17:01'! testParent locator := FSLocator image. self assert: locator parent resolve = FSLocator imageDirectory resolve! ! !FSLocatorTest methodsFor: 'resolution tests' stamp: 'cwp 2/19/2011 01:26'! testResolveAbsoluteReference | result reference | locator := FSLocator image / 'plonk'. reference := FSFilesystem inMemory root / 'griffle'. result := locator resolve: reference.. self assert: result == reference! ! !FSLocatorTest methodsFor: 'resolution tests' stamp: 'cwp 2/26/2011 18:19'! testResolveCompoundString | result compound | locator := FSLocator image / 'plonk'. compound := 'griffle', locator filesystem delimiter asString, 'nurp'. result := locator resolve: compound. self assert: result class = locator class. self assert: result origin = locator origin. self assert: result path = ((FSPath * 'plonk') / 'griffle' / 'nurp')! ! !FSLocatorTest methodsFor: 'resolution tests' stamp: 'cwp 2/26/2011 18:19'! testResolvePath | result path | locator := FSLocator image / 'plonk'. result := locator resolve: (FSPath * 'griffle'). path := (FSPath * 'plonk') / 'griffle'. self assert: result class= locator class. self assert: result origin = locator origin. self assert: result path = path.! ! !FSLocatorTest methodsFor: 'resolution tests' stamp: 'cwp 2/19/2011 01:26'! testResolveRelativeReference | result reference | locator := FSLocator image / 'plonk'. reference := FSFilesystem inMemory referenceTo: 'griffle'. result := locator resolve: reference.. self assert: result class= locator class. self assert: result origin = locator origin. self assert: result path = reference path.! ! !FSLocatorTest methodsFor: 'resolution tests' stamp: 'cwp 2/26/2011 18:19'! testResolveString | result path | locator := FSLocator image / 'plonk'. result := locator resolve: 'griffle'. path := (FSPath * 'plonk') / 'griffle'. self assert: result class= locator class. self assert: result origin = locator origin. self assert: result path = path.! ! !FSLocatorTest methodsFor: 'compatibility tests' stamp: 'lr 7/13/2010 15:18'! testSlash locator := FSLocator image / 'griffle'. self assert: locator = (FSLocator image / 'griffle')! ! !FSLocatorTest methodsFor: 'compatibility tests' stamp: 'lr 7/13/2010 15:18'! testWithExtensionAddsExtension locator := FSLocator image / 'griffle'. self assert: (locator withExtension: 'plonk') basename = 'griffle.plonk'! ! !FSLocatorTest methodsFor: 'compatibility tests' stamp: 'lr 7/13/2010 15:18'! testWithExtensionReplacesExtension locator := FSLocator image / 'griffle.nurp'. self assert: (locator withExtension: 'plonk') basename = 'griffle.plonk'! ! TestCase variableSubclass: #FSPathTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Filesystem-Tests'! !FSPathTest methodsFor: 'tests' stamp: 'cwp 2/27/2011 09:17'! testAbsolutePrintString | path actual | path := FSPath / 'plonk' / 'griffle'. actual := path printString. self assert: actual = 'FSPath / ''plonk'' / ''griffle'''! ! !FSPathTest methodsFor: 'tests' stamp: 'cwp 3/29/2011 16:45'! testAbsoluteWithParents | path allPaths | path := FSPath / 'plonk' / 'griffle' / 'nurb'. allPaths := path withParents. self assert: allPaths size = 4. self assert: allPaths first isRoot. self assert: allPaths second basename = 'plonk'. self assert: allPaths second size = 1. self assert: (allPaths second isChildOf: allPaths first). self assert: allPaths third basename = 'griffle'. self assert: allPaths third size = 2. self assert: (allPaths third isChildOf: allPaths second). self assert: allPaths fourth basename = 'nurb'. self assert: allPaths fourth size = 3. self assert: (allPaths fourth isChildOf: allPaths third). self assert: allPaths fourth = path. self assert: allPaths fourth == path! ! !FSPathTest methodsFor: 'tests' stamp: 'cwp 2/26/2011 10:59'! testAsReference | path reference | path := FSPath * 'plonk'. reference := path asReference. self assert: reference class = FSReference. self assert: reference path = path! ! !FSPathTest methodsFor: 'tests' stamp: 'cwp 2/26/2011 10:59'! testBasename | path | path := FSPath * 'plonk' / 'griffle'. self assert: path basename = 'griffle'! ! !FSPathTest methodsFor: 'tests' stamp: 'cwp 2/26/2011 18:01'! testCommaAddsExtension | path result | path := FSPath * 'plonk' . result := path, 'griffle'. self assert: result basename = 'plonk.griffle'! ! !FSPathTest methodsFor: 'tests' stamp: 'cwp 2/26/2011 10:59'! testCommaAddsExtensionAgain | path result | path := FSPath * 'plonk.griffle'. result := path, 'nurp'. self assert: result basename = 'plonk.griffle.nurp'! ! !FSPathTest methodsFor: 'tests' stamp: 'cwp 8/30/2009 15:07'! testContains | ancestor descendent | ancestor := FSPath / 'plonk'. descendent := FSPath / 'plonk' / 'griffle' / 'bork'. self assert: (ancestor contains: descendent). self deny: (descendent contains: ancestor)! ! !FSPathTest methodsFor: 'tests' stamp: 'cwp 2/18/2011 17:01'! testContainsLocator | ancestor descendent | ancestor := FSLocator imageDirectory resolve path. descendent := FSLocator image / 'griffle'. self deny: (ancestor contains: descendent). self deny: (descendent contains: ancestor)! ! !FSPathTest methodsFor: 'tests' stamp: 'cwp 2/26/2011 10:59'! testEqual | a b | a := FSPath * 'plonk'. b := FSPath * 'plonk'. self deny: a == b. self assert: a = b.! ! !FSPathTest methodsFor: 'tests' stamp: 'cwp 11/16/2009 09:37'! testGrandchildOfPath | griffle nurb | griffle := FSPath / 'griffle'. nurb := griffle / 'plonk' / 'nurb'. self deny: (griffle isChildOf: nurb). self deny: (nurb isChildOf: griffle).! ! !FSPathTest methodsFor: 'tests' stamp: 'cwp 10/10/2009 17:49'! testIsAbsolute self assert: (FSPath / 'plonk') isAbsolute! ! !FSPathTest methodsFor: 'tests' stamp: 'cwp 11/16/2009 09:34'! testIsChildOfPath | parent child | parent := FSPath / 'griffle'. child := parent / 'nurb'. self assert: (child isChildOf: parent). self deny: (parent isChildOf: child)! ! !FSPathTest methodsFor: 'tests' stamp: 'cwp 2/19/2011 01:26'! testIsChildOfReference | parent child | parent := FSPath / 'griffle'. child := (FSFilesystem inMemory referenceTo: parent / 'nurb'). self deny: (child isChildOf: parent). self deny: (parent isChildOf: child)! ! !FSPathTest methodsFor: 'tests' stamp: 'cwp 3/29/2011 16:31'! testIsEmpty self assert: (FSPath workingDirectory) isEmpty! ! !FSPathTest methodsFor: 'tests' stamp: 'cwp 2/26/2011 11:00'! testIsNotAbsolute self deny: (FSPath * 'plonk') isAbsolute! ! !FSPathTest methodsFor: 'tests' stamp: 'cwp 10/10/2009 17:49'! testIsNotRelative self deny: (FSPath / 'plonk') isRelative! ! !FSPathTest methodsFor: 'tests' stamp: 'cwp 2/26/2011 11:00'! testIsNotRoot self deny: (FSPath / 'plonk') isRoot! ! !FSPathTest methodsFor: 'tests' stamp: 'cwp 2/26/2011 11:00'! testIsRelative self assert: (FSPath * 'plonk') isRelative! ! !FSPathTest methodsFor: 'tests' stamp: 'cwp 7/17/2009 05:23'! testIsRoot self assert: FSPath root isRoot! ! !FSPathTest methodsFor: 'tests' stamp: 'cwp 3/29/2011 16:32'! testMakeRelative "self run: #testMakeRelative" | parent child relative | parent := FSPath / 'griffle' / 'bibb'. child := FSPath / 'griffle' / 'plonk' / 'nurp'. relative := parent makeRelative: child. self assert: relative = (FSPath parent / 'plonk' / 'nurp')! ! !FSPathTest methodsFor: 'tests' stamp: 'cwp 2/27/2011 09:40'! testParent | path parent | path := (FSPath * 'plonk') / 'griffle'. parent := path parent. self assert: parent isRelative. self assert: (parent at: 1) = 'plonk'! ! !FSPathTest methodsFor: 'tests' stamp: 'cwp 2/26/2011 11:00'! testParentParent | path | path := (FSPath * '..') parent. self assert: path size = 2. self assert: (path at: 1) = '..'. self assert: (path at: 2) = '..'.! ! !FSPathTest methodsFor: 'tests' stamp: 'cwp 2/26/2011 17:48'! testParentResolution | base relative absolute | base := FSPath / 'plonk' / 'pinto'. relative := FSPath parent / 'griffle' / 'zonk'. absolute := base resolve: relative. self assert: absolute isAbsolute. self assert: (absolute at: 1) = 'plonk'. self assert: (absolute at: 2) = 'griffle'. self assert: (absolute at: 3) = 'zonk'. ! ! !FSPathTest methodsFor: 'tests' stamp: 'cwp 3/29/2011 16:33'! testParse "self run: #testParse" | path | path := FSPath readFrom: 'parent/child/grandChild' readStream delimiter: $/. self assert: path size = 3. self assert: (path at: 1) = 'parent'. self assert: (path at: 2) = 'child'. self assert: (path at: 3) = 'grandChild'. ! ! !FSPathTest methodsFor: 'tests' stamp: 'cwp 3/29/2011 16:33'! testParseBogus "self run: #testParseBogus" | path | path := FSPath readFrom: 'parent?<>~ \child/grandChild' readStream delimiter: $/. self assert: path size = 2. self assert: (path at: 1) = 'parent?<>~ \child'. self assert: (path at: 2) = 'grandChild'. ! ! !FSPathTest methodsFor: 'tests' stamp: 'cwp 10/26/2009 13:27'! testParseTrailingSlash | path | path := FSPath readFrom: 'griffle/' readStream delimiter: $/. self assert: path size = 1. self assert: (path at: 1) = 'griffle'! ! !FSPathTest methodsFor: 'tests' stamp: 'cwp 3/29/2011 16:46'! testPrintRelativeWithParent | path | path := FSPath parent / 'foo'. self assert: (path printWithDelimiter: $/) = '../foo'! ! !FSPathTest methodsFor: 'tests' stamp: 'cwp 2/26/2011 11:00'! testPrintWithDelimiter | path | path := (FSPath * 'plonk') / 'griffle'. self assert: (path printWithDelimiter: $%) = 'plonk%griffle'! ! !FSPathTest methodsFor: 'tests' stamp: 'cwp 2/27/2011 09:31'! testRelativePrintString | path actual | path := FSPath * 'plonk' / 'griffle'. actual := path printString. self assert: actual = 'FSPath * ''plonk'' / ''griffle'''! ! !FSPathTest methodsFor: 'tests' stamp: 'StephaneDucasse 2/18/2011 21:55'! testRelativeTo "self run: #testRelativeTo" "aPath relativeTo: aParent returns a new path relative to the parent" | parent child relative | parent := FSPath / 'griffle'. child := FSPath / 'griffle' / 'plonk' / 'nurp'. relative := child relativeTo: parent. self assert: relative = (FSPath * 'plonk' / 'nurp')! ! !FSPathTest methodsFor: 'tests' stamp: 'cwp 11/15/2009 00:21'! testRelativeToBranch | parent child relative | parent := FSPath / 'griffle' / 'bibb'. child := FSPath / 'griffle' / 'plonk' / 'nurp'. relative := child relativeTo: parent. self assert: relative = (FSPath parent / 'plonk' / 'nurp')! ! !FSPathTest methodsFor: 'tests' stamp: 'cwp 3/29/2011 16:49'! testRelativeWithParents | path allPaths | path := FSPath * 'plonk' / 'griffle' / 'nurb'. allPaths := path withParents. self assert: allPaths size = 3. self assert: allPaths first basename = 'plonk'. self assert: allPaths first size = 1. self assert: allPaths second basename = 'griffle'. self assert: allPaths second size = 2. self assert: (allPaths second isChildOf: allPaths first). self assert: allPaths third basename = 'nurb'. self assert: allPaths third size = 3. self assert: (allPaths third isChildOf: allPaths second). self assert: allPaths third == path! ! !FSPathTest methodsFor: 'tests' stamp: 'cwp 11/16/2009 10:18'! testResolve | path | path := FSPath / 'griffle'. self assert: path resolve == path! ! !FSPathTest methodsFor: 'tests' stamp: 'cwp 3/29/2011 16:35'! testResolvePath "self debug: #testResolvePath" | path | path := FSPath / 'grandfather' / 'father' / 'child'. self assert: (path resolvePath: FSPath / 'grandfather') = (FSPath / 'grandfather'). self assert: (path resolvePath: FSPath / 'child') = (FSPath / 'child'). self assert: (path resolvePath: FSPath * 'grandfather') = (FSPath / 'grandfather' / 'father' / 'child' / 'grandfather'). self assert: (path resolvePath: FSPath * 'child') = (FSPath / 'grandfather' / 'father' / 'child' / 'child'). self assert: (path resolvePath: FSPath * 'grandfather') = (FSPath / 'grandfather' / 'father' / 'child' / 'grandfather'). self assert: (path resolvePath: FSPath * 'child') = (FSPath / 'grandfather' / 'father' / 'child' / 'child'). self assert: (path resolvePath: (FSPath parent) / '..') = (FSPath / 'grandfather') ! ! !FSPathTest methodsFor: 'tests' stamp: 'cwp 3/25/2011 21:54'! testResolveString "self debug: #testResolveString" | path result | path := FSPath * 'plonk'. result := path resolve: 'griffle'. self assert: result class = path class. self assert: result size = 2. self assert: (result at: 1) = 'plonk'. self assert: (result at: 2) = 'griffle'.! ! !FSPathTest methodsFor: 'tests' stamp: 'cwp 7/17/2009 23:40'! testRootParent | root | root := FSPath root. self assert: root parent == root! ! !FSPathTest methodsFor: 'tests' stamp: 'cwp 2/27/2011 09:30'! testRootPrintString | path actual | path := FSPath root. actual := path printString. self assert: actual = 'FSPath root'! ! !FSPathTest methodsFor: 'tests' stamp: 'cwp 11/16/2009 09:38'! testSiblingOfPath | griffle nurb | griffle := FSPath / 'griffle'. nurb := FSPath / 'nurb'. self deny: (griffle isChildOf: nurb). self deny: (nurb isChildOf: griffle).! ! !FSPathTest methodsFor: 'tests' stamp: 'cwp 2/26/2011 17:51'! testSimpleResolution | base relative absolute | base := FSPath / 'plonk'. relative := (FSPath * 'griffle') / 'zonk'. absolute := base resolve: relative. self assert: absolute isAbsolute. self assert: (absolute at: 1) = 'plonk'. self assert: (absolute at: 2) = 'griffle'. self assert: (absolute at: 3) = 'zonk'. ! ! !FSPathTest methodsFor: 'tests' stamp: 'cwp 2/26/2011 11:02'! testSlash | path actual | path := FSPath * 'plonk'. actual := path / 'griffle'. self assert: actual class = path class. self assert: (actual printWithDelimiter: $/) = 'plonk/griffle'! ! !FSPathTest methodsFor: 'tests' stamp: 'cwp 2/26/2011 11:01'! testUnequalContent | a b | a := FSPath * 'plonk'. b := FSPath * 'griffle'. self deny: a = b.! ! !FSPathTest methodsFor: 'tests' stamp: 'cwp 2/26/2011 11:02'! testUnequalSize | a b | a := FSPath * 'plonk'. b := (FSPath * 'plonk') / 'griffle'. self deny: a = b.! ! !FSPathTest methodsFor: 'tests' stamp: 'cwp 2/27/2011 09:39'! testWithExtentionAddsExtension | path result | path := FSPath * 'plonk'. result := path withExtension: 'griffle'. self assert: result basename = 'plonk.griffle'! ! !FSPathTest methodsFor: 'tests' stamp: 'cwp 2/26/2011 11:02'! testWithExtentionReplacesExtension | path result | path := FSPath * 'plonk.griffle'. result := path withExtension: 'griffle'. self assert: result basename = 'plonk.griffle'! ! !FSPathTest methodsFor: 'tests' stamp: 'cwp 2/27/2011 09:32'! testWorkingDirPrintString | path actual | path := FSPath workingDirectory. actual := path printString. self assert: actual = 'FSPath workingDirectory'! ! !FSPathTest methodsFor: 'tests' stamp: 'cwp 2/26/2011 18:22'! testWorkingDirectoryParent | path | path := FSPath workingDirectory parent. self assert: path size = 1. self assert: (path at: 1) = '..'! ! TestCase subclass: #FSReadStreamTest instanceVariableNames: 'filesystem stream' classVariableNames: '' poolDictionaries: '' category: 'Filesystem-Tests'! !FSReadStreamTest methodsFor: 'support' stamp: 'cwp 7/29/2009 22:43'! contents: aByteArray stream := filesystem writeStreamOn: 'griffle'. stream nextPutAll: aByteArray. stream close. stream := filesystem readStreamOn: 'griffle'! ! !FSReadStreamTest methodsFor: 'running' stamp: 'cwp 2/19/2011 01:26'! setUp filesystem := FSFilesystem inMemory. ! ! !FSReadStreamTest methodsFor: 'tests' stamp: 'cwp 7/29/2009 22:38'! testAtEnd self contents: #(). self assert: stream atEnd! ! !FSReadStreamTest methodsFor: 'tests' stamp: 'cwp 7/29/2009 22:57'! testDo | contents | self contents: #(1 2 3). contents := Array streamContents: [:out | stream do: [:ea | out nextPut: ea]]. self assert: contents = #(1 2 3)! ! !FSReadStreamTest methodsFor: 'tests' stamp: 'cwp 7/29/2009 23:00'! testNext self contents: #(1 2 3). self assert: stream next = 1! ! !FSReadStreamTest methodsFor: 'tests' stamp: 'cwp 7/29/2009 23:07'! testNextColon | result | self contents: #(1 2 3 4 5). result := stream next: 3. self assert: result = #(1 2 3) asByteArray.! ! !FSReadStreamTest methodsFor: 'tests' stamp: 'cwp 7/30/2009 23:54'! testNextInto | result buffer | self contents: #(1 2 3 4 5). buffer := ByteArray new: 3. result := stream nextInto: buffer. self assert: result == buffer. self assert: result = #(1 2 3) asByteArray! ! !FSReadStreamTest methodsFor: 'tests' stamp: 'cwp 7/29/2009 23:30'! testNextLineCR | result tail | self contents: #(97 97 97 13 98 98 98). result := stream nextLine. self assert: result = #(97 97 97) asByteArray. tail := stream next: 3. self assert: tail = #(98 98 98) asByteArray! ! !FSReadStreamTest methodsFor: 'tests' stamp: 'cwp 7/29/2009 23:31'! testNextLineCRLF | line tail | self contents: #(97 97 97 13 10 98 98 98). line := stream nextLine. self assert: line = #(97 97 97) asByteArray. tail := stream next: 3. self assert: tail = #(98 98 98) asByteArray! ! !FSReadStreamTest methodsFor: 'tests' stamp: 'cwp 7/29/2009 23:31'! testNextLineLF | result tail | self contents: #(97 97 97 10 98 98 98). result := stream nextLine. self assert: result = #(97 97 97) asByteArray. tail := stream next: 3. self assert: tail = #(98 98 98) asByteArray! ! !FSReadStreamTest methodsFor: 'tests' stamp: 'cwp 7/30/2009 23:04'! testNextMatchFalse self contents: #(1 2 3). self deny: (stream nextMatchFor: 5)! ! !FSReadStreamTest methodsFor: 'tests' stamp: 'cwp 7/30/2009 23:01'! testNextMatchTrue self contents: #(1 2 3). self assert: (stream nextMatchFor: 1)! ! !FSReadStreamTest methodsFor: 'tests' stamp: 'cwp 7/29/2009 22:46'! testNotAtEnd self contents: #(1 2 3). self deny: stream atEnd! ! !FSReadStreamTest methodsFor: 'tests' stamp: 'cwp 7/30/2009 23:05'! testPeek self contents: #(1 2 3). self assert: stream peek = 1. self assert: stream next = 1.! ! !FSReadStreamTest methodsFor: 'tests' stamp: 'cwp 7/30/2009 23:06'! testPeekForFalse self contents: #(1 2 3). self deny: (stream peekFor: 5) ! ! !FSReadStreamTest methodsFor: 'tests' stamp: 'cwp 7/30/2009 23:06'! testPeekForTrue self contents: #(1 2 3). self assert: (stream peekFor: 1) ! ! !FSReadStreamTest methodsFor: 'tests' stamp: 'cwp 7/30/2009 23:17'! testSkip self contents: #(1 2 3 4 5). stream skip: 3. self assert: stream position = 4! ! !FSReadStreamTest methodsFor: 'tests' stamp: 'cwp 7/30/2009 23:18'! testSkipPastEnd self contents: #(1 2 3 4 5). stream skip: 10. self assert: stream atEnd! ! !FSReadStreamTest methodsFor: 'tests' stamp: 'cwp 7/30/2009 23:20'! testSkipTo self contents: #(1 2 3 4 5). stream skipTo: 3. self assert: stream position = 4! ! !FSReadStreamTest methodsFor: 'tests' stamp: 'cwp 7/30/2009 23:24'! testSkipToEnd self contents: #(1 2 3 4 5). stream skipTo: 10. self assert: stream atEnd! ! !FSReadStreamTest methodsFor: 'tests' stamp: 'cwp 7/30/2009 23:27'! testSkipToFalse self contents: #(1 2 3 4 5). self deny: (stream skipTo: 10). ! ! !FSReadStreamTest methodsFor: 'tests' stamp: 'cwp 7/30/2009 23:25'! testSkipToTrue self contents: #(1 2 3 4 5). self assert: (stream skipTo: 4). ! ! !FSReadStreamTest methodsFor: 'tests' stamp: 'cwp 7/30/2009 23:38'! testUpTo | result | self contents: #(1 2 3 4 5). result := stream upTo: 4. self assert: result = #(1 2 3) asByteArray! ! !FSReadStreamTest methodsFor: 'tests' stamp: 'cwp 7/30/2009 23:38'! testUpToEnd | result | self contents: #(1 2 3 4 5). result := stream upTo: 7. self assert: result = #(1 2 3 4 5) asByteArray! ! TestCase variableSubclass: #FSReferenceCreationTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Filesystem-Tests'! !FSReferenceCreationTest methodsFor: 'tests' stamp: 'cwp 2/27/2011 09:09'! testCPath | ref | ref := FSReference C / 'WINDOWS'. self assert: (ref filesystem isKindOf: FSFilesystem). self assert: ref path = (FSPath / 'C:' / 'WINDOWS')! ! TestCase variableSubclass: #FSReferenceTest instanceVariableNames: 'filesystem' classVariableNames: '' poolDictionaries: '' category: 'Filesystem-Tests'! !FSReferenceTest methodsFor: 'support' stamp: 'cwp 11/17/2009 21:23'! createFile: aPath filesystem ensureDirectory: aPath parent. (filesystem writeStreamOn: aPath) close! ! !FSReferenceTest methodsFor: 'running' stamp: 'cwp 2/19/2011 01:26'! setUp filesystem := FSFilesystem inMemory.! ! !FSReferenceTest methodsFor: 'tests' stamp: 'sd 2/11/2011 19:21'! testAllChildren "allChildren returns all the files and folders recursively nested in a reference" "self debug: #testAllChildren" | ref children | filesystem createDirectory: '/alpha'. filesystem createDirectory: '/alpha/beta'. filesystem createDirectory: '/alpha/beta/delta'. filesystem createDirectory: '/alpha/gamma'. ref := filesystem referenceTo: '/alpha'. children := ref allChildren. "all children returns the nodes: '/alpha', '/alpha/beta', '/alpha/beta/delta', and '/alpha/gamma'." self assert: children size = 4. children do: [:child | self assert: child class = FSReference. self assert: (ref = child or: [ref contains: child])]. self assert: (children collect: [:ea | ea basename]) = #('alpha' 'beta' 'gamma' 'delta')! ! !FSReferenceTest methodsFor: 'tests' stamp: 'sd 2/11/2011 19:25'! testAllDirectories "allDirectories returns all folders recursively nested in a reference" "self debug: #testAllDirectories" | ref children | filesystem createDirectory: '/alpha'. filesystem createDirectory: '/alpha/beta'. filesystem createDirectory: '/alpha/beta/delta'. filesystem createDirectory: '/alpha/gamma'. ref := filesystem referenceTo: '/alpha'. children := ref allDirectories. "all children returns the directories: '/alpha', '/alpha/beta', and '/alpha/gamma'." self assert: children size = 4. children do: [:child | self assert: child class = FSReference. self assert: (ref = child or: [ref contains: child])]. self assert: (children collect: [:ea | ea basename]) = #('alpha' 'beta' 'gamma' 'delta')! ! !FSReferenceTest methodsFor: 'tests' stamp: 'cwp 11/17/2009 16:44'! testAllEntries | ref entries | filesystem createDirectory: '/alpha'. filesystem createDirectory: '/alpha/beta'. filesystem createDirectory: '/alpha/beta/delta'. filesystem createDirectory: '/alpha/gamma'. ref := filesystem referenceTo: '/alpha'. entries := ref allEntries. self assert: entries size = 4. entries do: [:entry | self assert: entry class = FSDirectoryEntry. self assert: (ref = entry reference or: [ref contains: entry reference])]. self assert: (entries collect: [:ea | ea basename]) = #('alpha' 'beta' 'gamma' 'delta')! ! !FSReferenceTest methodsFor: 'tests' stamp: 'cwp 3/25/2011 22:09'! testAsAbsoluteConverted "Converts a relative reference to absolute, and asserts that it's absolute and still has the same path." | ref absolute | ref := filesystem referenceTo: 'plonk'. absolute := ref asAbsolute. self assert: absolute isAbsolute. self assert: (absolute path at: 1) = 'plonk'! ! !FSReferenceTest methodsFor: 'tests' stamp: 'cwp 7/22/2009 08:30'! testAsAbsoluteIdentity | ref | ref := filesystem referenceTo: '/plonk'. self assert: ref asAbsolute == ref! ! !FSReferenceTest methodsFor: 'tests' stamp: 'cwp 7/20/2009 09:08'! testAsReference | ref | ref := filesystem referenceTo: 'plonk'. self assert: ref asReference == ref! ! !FSReferenceTest methodsFor: 'tests' stamp: 'StephaneDucasse 2/2/2011 22:46'! testBaseAndExtension "self debug: #testBaseAndExtension" | ref | ref := filesystem referenceTo: 'plonk/griffle.taz'. "We create a reference to the plonk/griffle.taz in the context of filesystem" self assert: ref base = 'griffle'. self assert: ref extension = 'taz'. "Note that the extension of a complex extension starts from the first period up until the end" ref := filesystem referenceTo: 'plonk/griffle.taz.txt'. self assert: ref base = 'griffle'. self assert: ref extension = 'taz.txt'.! ! !FSReferenceTest methodsFor: 'tests' stamp: 'StephaneDucasse 2/2/2011 22:47'! testBasename "self debug: #testBasename" | ref | ref := filesystem referenceTo: 'plonk/griffle'. self assert: ref basename = 'griffle'. ref := filesystem referenceTo: 'plonk/griffle.taz'. self assert: ref basename = 'griffle.taz'.! ! !FSReferenceTest methodsFor: 'tests' stamp: 'sd 2/11/2011 19:55'! testChildDirectories | childDirectories | filesystem createDirectory: '/beta'. filesystem createDirectory: '/gamma'. (filesystem referenceTo: '/delta') writeStreamDo: [ :stream | stream nextPutAll: '1' ]. (filesystem referenceTo: '/epsilon') writeStreamDo: [ :stream | stream nextPutAll: '2' ]. childDirectories := filesystem root directories. self assert: childDirectories size = 2. childDirectories do: [ :each | self assert: each class = FSReference. self assert: each isDirectory description: 'Collection should not contain references to files.' ]! ! !FSReferenceTest methodsFor: 'tests' stamp: 'sd 2/11/2011 19:55'! testChildFiles | childFiles | filesystem createDirectory: '/beta'. filesystem createDirectory: '/gamma'. (filesystem referenceTo: '/delta') writeStreamDo: [ :stream | stream nextPutAll: '1' ]. (filesystem referenceTo: '/epsilon') writeStreamDo: [ :stream | stream nextPutAll: '2' ]. childFiles := filesystem root files. self assert: childFiles size = 2. childFiles do: [ :each | self assert: each class = FSReference. self assert: each isFile description: 'Collection should not contain references to directories.' ]! ! !FSReferenceTest methodsFor: 'tests' stamp: 'cwp 11/16/2009 09:33'! testChildOfPath | parent child | parent := FSPath / 'griffle'. child := filesystem referenceTo: '/griffle/nurb'. self deny: (child isChildOf: parent). self deny: (parent isChildOf: child).! ! !FSReferenceTest methodsFor: 'tests' stamp: 'cwp 11/16/2009 09:31'! testChildOfReference | parent child | parent := filesystem referenceTo: '/griffle'. child := filesystem referenceTo: '/griffle/nurb'. self assert: (child isChildOf: parent). self deny: (parent isChildOf: child).! ! !FSReferenceTest methodsFor: 'tests' stamp: 'cwp 11/16/2009 09:02'! testChildren | ref children | filesystem createDirectory: '/alpha'. filesystem createDirectory: '/alpha/beta'. filesystem createDirectory: '/alpha/gamma'. ref := filesystem referenceTo: '/alpha'. children := ref children. self assert: children size = 2. children do: [:child | self assert: child class = FSReference. self assert: (child isChildOf: ref). self assert: (#('beta' 'gamma') includes: child basename)]! ! !FSReferenceTest methodsFor: 'tests' stamp: 'cwp 10/25/2009 11:11'! testCommaAddsExtension | ref result | ref := filesystem referenceTo: 'plonk'. result := ref, 'griffle'. self assert: result basename = 'plonk.griffle'! ! !FSReferenceTest methodsFor: 'tests' stamp: 'cwp 11/17/2009 23:53'! testCommaAddsExtensionAgain | ref result | ref := filesystem referenceTo: 'plonk.griffle'. result := ref, 'nurp'. self assert: result basename = 'plonk.griffle.nurp'! ! !FSReferenceTest methodsFor: 'tests' stamp: 'cwp 2/18/2011 17:01'! testContainsLocator | ref | ref := FSLocator imageDirectory resolve parent. self assert: (ref contains: FSLocator image)! ! !FSReferenceTest methodsFor: 'tests' stamp: 'cwp 2/26/2011 18:05'! testContainsPath | ref | ref := filesystem referenceTo: (FSPath * 'griffle'). self assert: (ref contains: (ref / 'nurp') path)! ! !FSReferenceTest methodsFor: 'tests' stamp: 'cwp 2/26/2011 18:05'! testContainsReference | ref | ref := filesystem referenceTo: (FSPath * 'griffle'). self assert: (ref contains: ref / 'nurp')! ! !FSReferenceTest methodsFor: 'tests' stamp: 'cwp 10/26/2009 00:56'! testDoesntContainLocator | ref | ref := filesystem referenceTo: 'griffle'. self deny: (ref contains: FSLocator image)! ! !FSReferenceTest methodsFor: 'tests' stamp: 'cwp 2/26/2011 18:05'! testDoesntContainPath | ref | ref := filesystem referenceTo: (FSPath * 'griffle'). self deny: (ref contains: (FSPath * 'nurp'))! ! !FSReferenceTest methodsFor: 'tests' stamp: 'cwp 2/26/2011 18:06'! testDoesntContainReferenceFilesystem | ref other | ref := filesystem referenceTo: (FSPath * 'griffle'). other := FSFilesystem inMemory referenceTo: 'griffle/nurp'. self deny: (ref contains: other)! ! !FSReferenceTest methodsFor: 'tests' stamp: 'cwp 2/26/2011 18:06'! testDoesntContainReferencePath | ref other | ref := filesystem referenceTo: (FSPath * 'griffle'). other := filesystem referenceTo: (FSPath * 'nurp'). self deny: (ref contains: other)! ! !FSReferenceTest methodsFor: 'tests' stamp: 'StephaneDucasse 2/3/2011 08:15'! testEntries | ref entries | filesystem createDirectory: '/alpha'. filesystem createDirectory: '/alpha/beta'. filesystem createDirectory: '/alpha/gamma'. ref := filesystem referenceTo: '/alpha'. entries := ref entries. self assert: entries size = 2. entries do: [:entry | self assert: entry class = FSDirectoryEntry. self assert: (entry reference isChildOf: ref). self assert: (#('beta' 'gamma') includes: entry reference basename)]! ! !FSReferenceTest methodsFor: 'tests' stamp: 'StephaneDucasse 2/3/2011 08:15'! testEqual | a b | a := filesystem referenceTo: 'plonk'. b := filesystem referenceTo: 'plonk'. self deny: a == b. self assert: a = b.! ! !FSReferenceTest methodsFor: 'tests' stamp: 'cwp 11/16/2009 09:32'! testGrandchildOfReference | griffle nurb | griffle := filesystem referenceTo: '/griffle'. nurb := filesystem referenceTo: '/griffle/plonk/nurb'. self deny: (griffle isChildOf: nurb). self deny: (nurb isChildOf: griffle).! ! !FSReferenceTest methodsFor: 'tests' stamp: 'cwp 7/20/2009 09:23'! testIsAbsolute self assert: (filesystem referenceTo: '/plonk') isAbsolute! ! !FSReferenceTest methodsFor: 'tests' stamp: 'cwp 7/20/2009 09:24'! testIsNotAbsolute self deny: (filesystem referenceTo: 'plonk') isAbsolute! ! !FSReferenceTest methodsFor: 'tests' stamp: 'cwp 7/20/2009 09:25'! testIsNotRelative self deny: (filesystem referenceTo: '/plonk') isRelative! ! !FSReferenceTest methodsFor: 'tests' stamp: 'cwp 2/26/2011 18:06'! testIsNotRoot self deny: (filesystem referenceTo: FSPath / 'plonk') isRoot! ! !FSReferenceTest methodsFor: 'tests' stamp: 'cwp 7/20/2009 09:26'! testIsRelative self assert: (filesystem referenceTo: 'plonk') isRelative! ! !FSReferenceTest methodsFor: 'tests' stamp: 'cwp 7/20/2009 09:27'! testIsRoot self assert: (filesystem referenceTo: FSPath root) isRoot! ! !FSReferenceTest methodsFor: 'tests' stamp: 'cwp 3/29/2011 17:05'! testMakeRelative "self run: #testMakeRelative" | parent child relative | parent := filesystem referenceTo: (FSPath / 'griffle'). child := filesystem referenceTo: (FSPath / 'griffle' / 'plonk' / 'nurb'). relative := parent makeRelative: child. self assert: relative = (FSPath * 'plonk' / 'nurb')! ! !FSReferenceTest methodsFor: 'tests' stamp: 'cwp 2/26/2011 18:07'! testParent | ref parent | ref := (filesystem referenceTo: 'plonk/griffle'). parent := ref parent. self assert: parent class = ref class. self assert: (parent path at: 1) = 'plonk'! ! !FSReferenceTest methodsFor: 'tests' stamp: 'cwp 2/26/2011 18:08'! testParentResolutionWithAbsoluteReference | base relative absolute | base := (filesystem referenceTo: '/plonk/pinto'). relative := (FSFilesystem inMemory referenceTo: '/griffle/zonk'). absolute := base resolve: relative. self assert: absolute filesystem == relative filesystem. self assert: absolute isAbsolute. self assert: (absolute path at: 1) = 'griffle'. self assert: (absolute path at: 2) = 'zonk'. ! ! !FSReferenceTest methodsFor: 'tests' stamp: 'cwp 2/26/2011 18:09'! testParentResolutionWithPath | base relative absolute | base := filesystem referenceTo: (FSPath / 'plonk' / 'pinto'). relative := FSPath parent / 'griffle' / 'zonk'. absolute := base resolve: relative. self assert: absolute isAbsolute. self assert: (absolute path at: 1) = 'plonk'. self assert: (absolute path at: 2) = 'griffle'. self assert: (absolute path at: 3) = 'zonk'. ! ! !FSReferenceTest methodsFor: 'tests' stamp: 'cwp 2/26/2011 18:10'! testParentResolutionWithReference | base relative absolute | base := (filesystem referenceTo: '/plonk/pinto'). relative := (filesystem referenceTo: '../griffle/zonk'). absolute := base resolve: relative. self assert: absolute isAbsolute. self assert: (absolute path at: 1) = 'plonk'. self assert: (absolute path at: 2) = 'griffle'. self assert: (absolute path at: 3) = 'zonk'. ! ! !FSReferenceTest methodsFor: 'tests' stamp: 'cwp 2/26/2011 18:10'! testParentResolutionWithRemoteReference | base relative absolute | base := (filesystem referenceTo: '/plonk/pinto'). relative := (FSFilesystem inMemory referenceTo: '../griffle/zonk'). absolute := base resolve: relative. self assert: absolute isAbsolute. self assert: (absolute path at: 1) = 'plonk'. self assert: (absolute path at: 2) = 'griffle'. self assert: (absolute path at: 3) = 'zonk'. ! ! !FSReferenceTest methodsFor: 'tests' stamp: 'DamienPollet 2/28/2011 23:23'! testPathRelativeTo | parent childPath relative | parent := filesystem referenceTo: (FSPath / 'griffle'). childPath := FSPath / 'griffle' / 'plonk' / 'nurb'. relative := childPath relativeTo: parent. self assert: relative = (FSPath * 'plonk' / 'nurb')! ! !FSReferenceTest methodsFor: 'tests' stamp: 'cwp 2/26/2011 18:11'! testReadStream | ref stream path | path := FSPath * 'plonk'. filesystem store createFile: path. ref := filesystem referenceTo: path. [stream := ref readStream. self assert: stream class = FSReadStream ] ensure: [ stream ifNotNil: [ stream close ] ]! ! !FSReferenceTest methodsFor: 'tests' stamp: 'cwp 2/18/2011 16:17'! testReadStreamDo | ref path s | path := FSPath * 'plonk'. filesystem store createFile: path. ref := filesystem referenceTo: path. ref readStreamDo: [ :stream | self assert: stream class = FSReadStream. self assert: stream isOpen. s := stream ]. self deny: s isOpen! ! !FSReferenceTest methodsFor: 'tests stream' stamp: 'cwp 11/14/2009 23:37'! testReadStreamDoNotFound | ref path | path := FSPath * 'plonk'. ref := filesystem referenceTo: path. self should: [ref readStreamDo: [:s]] raise: FSFileDoesNotExist ! ! !FSReferenceTest methodsFor: 'tests' stamp: 'cwp 2/18/2011 16:17'! testReadStreamDoifAbsent | ref path s | path := FSPath * 'plonk'. filesystem store createFile: path. ref := filesystem referenceTo: path. ref readStreamDo: [ :stream | self assert: stream class = FSReadStream. self assert: stream isOpen. s := stream ] ifAbsent: [ self signalFailure: 'The file exists!!' ]. self deny: s isOpen! ! !FSReferenceTest methodsFor: 'tests' stamp: 'cwp 10/29/2009 09:59'! testReadStreamDoifAbsentNot | ref pass | pass := false. ref := filesystem referenceTo: 'plonk'. ref readStreamDo: [:stream] ifAbsent: [pass := true]. self assert: pass! ! !FSReferenceTest methodsFor: 'tests' stamp: 'cwp 2/26/2011 18:11'! testReadStreamIfAbsent | ref stream path | path := FSPath * 'plonk'. filesystem store createFile: path. ref := filesystem referenceTo: path. [ stream := ref readStreamIfAbsent: [ self signalFailure: 'Should not reach here.' ]. self assert: stream class = FSReadStream ] ensure: [ stream ifNotNil: [ stream close ] ]! ! !FSReferenceTest methodsFor: 'tests' stamp: 'cwp 11/14/2009 23:36'! testReadStreamNotFound | ref path | path := FSPath * 'plonk'. ref := filesystem referenceTo: path. self should: [ref readStream] raise: FSFileDoesNotExist ! ! !FSReferenceTest methodsFor: 'tests' stamp: 'DamienPollet 2/28/2011 18:57'! testRelativeToPath | parentPath child relative | parentPath := FSPath / 'griffle'. child := filesystem referenceTo: (FSPath / 'griffle' / 'plonk' / 'nurb'). relative := child relativeTo: parentPath. self assert: relative = (FSPath * 'plonk' / 'nurb')! ! !FSReferenceTest methodsFor: 'tests' stamp: 'cwp 11/15/2009 00:25'! testRelativeToReference | parent child relative | parent := filesystem referenceTo: (FSPath / 'griffle'). child := filesystem referenceTo: (FSPath / 'griffle' / 'plonk' / 'nurb'). relative := child relativeTo: parent. self assert: relative = (FSPath * 'plonk' / 'nurb')! ! !FSReferenceTest methodsFor: 'tests' stamp: 'cwp 11/16/2009 10:17'! testResolve | ref | ref := filesystem referenceTo: FSPath / 'griffle'. self assert: ref resolve == ref! ! !FSReferenceTest methodsFor: 'tests' stamp: 'cwp 7/20/2009 09:34'! testRootParent | root | root := filesystem referenceTo: FSPath root. self assert: root parent == root! ! !FSReferenceTest methodsFor: 'tests' stamp: 'cwp 11/16/2009 09:32'! testSiblingOfReference | griffle nurb | griffle := filesystem referenceTo: '/griffle'. nurb := filesystem referenceTo: '/nurb'. self deny: (griffle isChildOf: nurb). self deny: (nurb isChildOf: griffle).! ! !FSReferenceTest methodsFor: 'tests' stamp: 'cwp 2/26/2011 18:12'! testSimpleResolution | base relative absolute | base := filesystem referenceTo: FSPath / 'plonk'. relative := (FSPath * 'griffle') / 'zonk'. absolute := base resolve: relative. self assert: absolute isAbsolute. self assert: (absolute path at: 1) = 'plonk'. self assert: (absolute path at: 2) = 'griffle'. self assert: (absolute path at: 3) = 'zonk'. ! ! !FSReferenceTest methodsFor: 'tests' stamp: 'cwp 2/26/2011 18:13'! testSlash | ref result | ref := filesystem referenceTo: 'plonk'. result := ref / 'griffle'. self assert: result class = ref class. self assert: result isRelative. self assert: (result path at: 1) = 'plonk'. self assert: (result path at: 2) = 'griffle'. ! ! !FSReferenceTest methodsFor: 'tests' stamp: 'cwp 7/20/2009 09:37'! testUnequalContent | a b | a := filesystem referenceTo: 'plonk'. b := filesystem referenceTo: 'griffle'. self deny: a = b.! ! !FSReferenceTest methodsFor: 'tests' stamp: 'cwp 7/20/2009 09:56'! testUnequalSize | a b | a := filesystem referenceTo: 'plonk'. b := filesystem referenceTo: 'plonk/griffle'. self deny: a = b.! ! !FSReferenceTest methodsFor: 'tests' stamp: 'cwp 2/26/2011 18:14'! testWithExtentionAddsExtension | ref result | ref := filesystem referenceTo: 'plonk'. result := ref withExtension: 'griffle'. self assert: result isRelative. self assert: result basename = 'plonk.griffle'! ! !FSReferenceTest methodsFor: 'tests' stamp: 'cwp 2/26/2011 18:14'! testWithExtentionReplacesExtension | ref result | ref := filesystem referenceTo: 'plonk.griffle'. result := ref withExtension: 'nurp'. self assert: result isRelative. self assert: result basename = 'plonk.nurp'! ! !FSReferenceTest methodsFor: 'tests' stamp: 'cwp 2/26/2011 18:22'! testWorkingDirectoryParent | wd | wd := filesystem referenceTo: FSPath workingDirectory. self assert: wd parent path size = 1. self assert: (wd parent path at: 1) = '..'.! ! !FSReferenceTest methodsFor: 'tests' stamp: 'cwp 10/29/2009 09:41'! testWriteStream | ref stream | ref := filesystem referenceTo: 'plonk'. [stream := ref writeStream. self assert: (stream class = FSWriteStream)] ensure: [stream ifNotNil: [stream close]]! ! !FSReferenceTest methodsFor: 'tests' stamp: 'cwp 10/29/2009 09:53'! testWriteStreamDo | ref s | ref := filesystem referenceTo: 'plonk'. ref writeStreamDo: [:stream | s := stream. self assert: stream class = FSWriteStream. self assert: stream isOpen]. self deny: s isOpen ! ! !FSReferenceTest methodsFor: 'tests' stamp: 'cwp 2/18/2011 16:17'! testWriteStreamDoExists | ref s path | path := FSPath * 'plonk'. filesystem store createFile: path. ref := filesystem referenceTo: path. ref writeStreamDo: [ :stream | s := stream. self assert: stream class = FSWriteStream. self assert: stream isOpen ]. self deny: s isOpen! ! !FSReferenceTest methodsFor: 'tests' stamp: 'cwp 10/29/2009 09:54'! testWriteStreamDoifPresent | ref s | ref := filesystem referenceTo: 'plonk'. ref writeStreamDo: [:stream | s := stream. self assert: stream class = FSWriteStream. self assert: stream isOpen] ifPresent: [self signalFailure: 'The file does not exist!!']. self deny: s isOpen ! ! !FSReferenceTest methodsFor: 'tests' stamp: 'cwp 2/18/2011 16:17'! testWriteStreamDoifPresentNot | ref pass path | pass := false. path := FSPath * 'plonk'. filesystem store createFile: path. ref := filesystem referenceTo: path. ref writeStreamDo: [ :stream | ] ifPresent: [ pass := true ]. self assert: pass! ! !FSReferenceTest methodsFor: 'tests' stamp: 'cwp 2/26/2011 18:15'! testWriteStreamExists | ref stream path | path := FSPath * 'plonk'. filesystem store createFile: path. ref := filesystem referenceTo: path. [stream := ref writeStream. self assert: stream class = FSWriteStream ] ensure: [ stream ifNotNil: [ stream close ] ]! ! !FSReferenceTest methodsFor: 'tests' stamp: 'cwp 10/29/2009 11:05'! testWriteStreamifPresent | ref stream | ref := filesystem referenceTo: 'plonk'. [stream := ref writeStreamIfPresent: [self signalFailure: 'Should not reach here']. self assert: (stream class = FSWriteStream)] ensure: [stream ifNotNil: [stream close]]! ! !FSReferenceTest methodsFor: 'tests' stamp: 'cwp 2/18/2011 16:17'! testWriteStreamifPresentExists | ref pass path | pass := false. path := FSPath * 'plonk'. filesystem store createFile: path. ref := filesystem referenceTo: path. ref writeStreamIfPresent: [ pass := true ]. self assert: pass! ! TestCase subclass: #FSResolverTest instanceVariableNames: 'resolver' classVariableNames: '' poolDictionaries: '' category: 'Filesystem-Tests'! FSResolverTest subclass: #FSInteractiveResolverTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Filesystem-Tests'! !FSInteractiveResolverTest methodsFor: 'running' stamp: 'cwp 10/27/2009 11:09'! createResolver ^ FSInteractiveResolver new! ! !FSInteractiveResolverTest methodsFor: 'accessing' stamp: 'cwp 2/18/2011 17:01'! home ^ FSLocator imageDirectory resolve! ! !FSInteractiveResolverTest methodsFor: 'tests' stamp: 'cwp 10/27/2009 11:16'! testCached [resolver resolve: #home] on: FSResolutionRequest do: [:req | req resume: self home]. self shouldnt: [self assertOriginResolves: #home] raise: FSResolutionRequest! ! !FSInteractiveResolverTest methodsFor: 'tests' stamp: 'cwp 10/27/2009 11:15'! testNew [self assertOriginResolves: #home] on: FSResolutionRequest do: [:req | req resume: self home]. ! ! FSResolverTest subclass: #FSPlatformResolverTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Filesystem-Tests'! !FSPlatformResolverTest methodsFor: 'running' stamp: 'cwp 10/27/2009 10:57'! createResolver ^ FSPlatformResolver forCurrentPlatform! ! !FSPlatformResolverTest methodsFor: 'tests' stamp: 'cwp 10/27/2009 11:04'! testDesktop self assertOriginResolves: #desktop! ! !FSPlatformResolverTest methodsFor: 'tests' stamp: 'cwp 10/27/2009 21:49'! testDocuments self assertOriginResolves: #documents! ! !FSPlatformResolverTest methodsFor: 'tests' stamp: 'cwp 10/27/2009 10:57'! testHome self assertOriginResolves: #home! ! !FSResolverTest class methodsFor: 'testing' stamp: 'cwp 10/26/2009 21:28'! isAbstract ^ self name = #FSResolverTest! ! !FSResolverTest methodsFor: 'asserting' stamp: 'cwp 10/26/2009 21:22'! assertOriginResolves: aSymbol | reference | reference := resolver resolve: aSymbol. self assert: (reference isKindOf: FSReference). self assert: reference isAbsolute. self assert: reference exists! ! !FSResolverTest methodsFor: 'running' stamp: 'cwp 10/27/2009 11:12'! createResolver self subclassResponsibility ! ! !FSResolverTest methodsFor: 'running' stamp: 'cwp 10/26/2009 21:25'! setUp resolver := self createResolver.! ! FSResolverTest subclass: #FSSystemResolverTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Filesystem-Tests'! !FSSystemResolverTest methodsFor: 'running' stamp: 'cwp 10/26/2009 21:26'! createResolver ^ FSSystemResolver new! ! !FSSystemResolverTest methodsFor: 'testing' stamp: 'lr 7/13/2010 13:32'! testChanges self assertOriginResolves: #changes! ! !FSSystemResolverTest methodsFor: 'testing' stamp: 'cwp 10/26/2009 13:21'! testImage self assertOriginResolves: #image! ! !FSSystemResolverTest methodsFor: 'testing' stamp: 'lr 7/13/2010 13:35'! testImageDirectory self assertOriginResolves: #imageDirectory! ! !FSSystemResolverTest methodsFor: 'testing' stamp: 'cwp 10/26/2009 13:21'! testVmBinary self assertOriginResolves: #vmBinary! ! !FSSystemResolverTest methodsFor: 'testing' stamp: 'cwp 10/26/2009 13:21'! testVmDirectory self assertOriginResolves: #vmDirectory! ! TestCase subclass: #FSTreeTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Filesystem-Tests'! FSTreeTest subclass: #FSCopyVisitorTest instanceVariableNames: 'source dest' classVariableNames: '' poolDictionaries: '' category: 'Filesystem-Tests'! !FSCopyVisitorTest methodsFor: 'running' stamp: 'cwp 2/18/2011 16:40'! createDirectory: aString source createDirectory: (source store pathFromString: aString)! ! !FSCopyVisitorTest methodsFor: 'running' stamp: 'cwp 2/18/2011 16:40'! createFile: aString source store createFile: (source store pathFromString: aString)! ! !FSCopyVisitorTest methodsFor: 'running' stamp: 'cwp 2/19/2011 01:26'! setUp source := FSFilesystem inMemory. dest := FSFilesystem inMemory. ! ! !FSCopyVisitorTest methodsFor: 'tests' stamp: 'cwp 11/15/2009 00:33'! testAll self setUpGreek. FSCopyVisitor copy: (source referenceTo: '/alpha') to: (dest referenceTo: '/alpha'). self assert: (dest isDirectory: '/alpha'). self assert: (dest isFile: '/alpha/beta/gamma').! ! FSTreeTest subclass: #FSSingleTreeTest instanceVariableNames: 'filesystem' classVariableNames: '' poolDictionaries: '' category: 'Filesystem-Tests'! FSSingleTreeTest subclass: #FSCollectVisitorTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Filesystem-Tests'! !FSCollectVisitorTest methodsFor: 'asserting' stamp: 'cwp 11/16/2009 10:56'! assertEntries: references are: expected | strings | self assert: references isArray. references do: [ :ea | self assert: ea class = FSDirectoryEntry ]. strings := references collect: [ :ea | ea reference pathString ]. self assert: strings = expected! ! !FSCollectVisitorTest methodsFor: 'accessing' stamp: 'cwp 11/15/2009 07:47'! root ^ filesystem referenceTo: '/alpha'! ! !FSCollectVisitorTest methodsFor: 'running' stamp: 'cwp 11/15/2009 08:04'! setUp super setUp. self setUpGreek.! ! !FSCollectVisitorTest methodsFor: 'tests' stamp: 'cwp 11/16/2009 10:56'! testBreadthFirst | entries | entries := FSCollectVisitor breadthFirst: self root. self assertEntries: entries are: #( '/alpha' '/alpha/beta' '/alpha/epsilon' '/alpha/beta/delta' '/alpha/beta/gamma' '/alpha/epsilon/zeta' )! ! !FSCollectVisitorTest methodsFor: 'tests' stamp: 'cwp 11/16/2009 10:56'! testPostorder | entries | entries := FSCollectVisitor postorder: self root. self assertEntries: entries are: #( '/alpha/beta/delta' '/alpha/beta/gamma' '/alpha/beta' '/alpha/epsilon/zeta' '/alpha/epsilon' '/alpha' )! ! !FSCollectVisitorTest methodsFor: 'tests' stamp: 'cwp 11/16/2009 10:57'! testPreorder | entries | entries := FSCollectVisitor preorder: self root. self assertEntries: entries are: #( '/alpha' '/alpha/beta' '/alpha/beta/delta' '/alpha/beta/gamma' '/alpha/epsilon' '/alpha/epsilon/zeta' )! ! FSSingleTreeTest subclass: #FSDeleteVisitorTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Filesystem-Tests'! !FSDeleteVisitorTest methodsFor: 'tests' stamp: 'cwp 11/15/2009 00:48'! testBeta self setUpGreek. FSDeleteVisitor delete: (filesystem referenceTo: '/alpha/beta'). self assert: (filesystem isDirectory: '/alpha'). self assert: (filesystem isDirectory: '/alpha/epsilon'). self deny: (filesystem exists: '/alpha/beta'). ! ! FSSingleTreeTest subclass: #FSGuideTest instanceVariableNames: 'guide visited' classVariableNames: '' poolDictionaries: '' category: 'Filesystem-Tests'! FSGuideTest subclass: #FSBreadthFirstGuideTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Filesystem-Tests'! !FSBreadthFirstGuideTest methodsFor: 'tests' stamp: 'cwp 10/29/2009 23:39'! testAll guide := FSBreadthFirstGuide for: self. guide show: (filesystem referenceTo: '/alpha'). self assertVisitedIs: #( 'alpha' 'beta' 'epsilon' 'delta' 'gamma' 'zeta' )! ! !FSGuideTest class methodsFor: 'testing' stamp: 'cwp 10/29/2009 23:08'! isAbstract ^ self name = #FSGuideTest! ! !FSGuideTest methodsFor: 'asserting' stamp: 'cwp 11/16/2009 10:46'! assertVisitedIs: anArray visited with: anArray do: [:entry :basename | self assert: entry reference basename = basename]! ! !FSGuideTest methodsFor: 'running' stamp: 'cwp 2/19/2011 01:26'! setUp visited := OrderedCollection new. filesystem := FSFilesystem inMemory. self setUpGreek! ! !FSGuideTest methodsFor: 'visitor' stamp: 'cwp 10/29/2009 21:54'! visitDirectory: aReference visited add: aReference.! ! !FSGuideTest methodsFor: 'visitor' stamp: 'cwp 10/29/2009 21:54'! visitFile: aReference visited add: aReference.! ! FSGuideTest subclass: #FSPostorderGuideTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Filesystem-Tests'! !FSPostorderGuideTest methodsFor: 'tests' stamp: 'cwp 10/29/2009 23:34'! testAll guide := FSPostorderGuide for: self. guide show: (filesystem referenceTo: '/alpha'). self assertVisitedIs: #( 'delta' 'gamma' 'beta' 'zeta' 'epsilon' 'alpha' )! ! FSGuideTest subclass: #FSPreorderGuideTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Filesystem-Tests'! !FSPreorderGuideTest methodsFor: 'tests' stamp: 'cwp 10/29/2009 23:34'! testAll guide := FSPreorderGuide for: self. guide show: (filesystem referenceTo: '/alpha'). self assertVisitedIs: #( 'alpha' 'beta' 'delta' 'gamma' 'epsilon' 'zeta' )! ! !FSSingleTreeTest class methodsFor: 'testing' stamp: 'lr 7/13/2010 13:48'! isAbstract ^ self name = #FSSingleTreeTest! ! !FSSingleTreeTest methodsFor: 'running' stamp: 'cwp 11/21/2009 11:30'! createDirectory: aString filesystem createDirectory: (filesystem pathFromString: aString)! ! !FSSingleTreeTest methodsFor: 'running' stamp: 'cwp 2/18/2011 16:17'! createFile: aString filesystem store createFile: (filesystem pathFromString: aString)! ! !FSSingleTreeTest methodsFor: 'running' stamp: 'cwp 2/19/2011 01:26'! setUp super setUp. filesystem := FSFilesystem inMemory. ! ! !FSTreeTest class methodsFor: 'testing' stamp: 'cwp 10/30/2009 13:39'! isAbstract ^ self name = #FSTreeTest! ! !FSTreeTest methodsFor: 'running' stamp: 'lr 7/13/2010 15:26'! createDirectory: aString self subclassResponsibility! ! !FSTreeTest methodsFor: 'running' stamp: 'lr 7/13/2010 15:26'! createFile: aString self subclassResponsibility! ! !FSTreeTest methodsFor: 'running' stamp: 'cwp 10/30/2009 13:32'! setUpGreek self createDirectory: '/alpha'; createDirectory: '/alpha/beta'; createFile: '/alpha/beta/gamma'; createFile: '/alpha/beta/delta'; createDirectory: '/alpha/epsilon'; createFile: '/alpha/epsilon/zeta'! ! TestCase subclass: #FSWriteStreamTest instanceVariableNames: 'filesystem stream' classVariableNames: '' poolDictionaries: '' category: 'Filesystem-Tests'! !FSWriteStreamTest methodsFor: 'accessing' stamp: 'cwp 2/18/2011 12:52'! contents ^ (filesystem instVarNamed: 'store') nodeAt: FSPath / 'giffle' ifPresent: [:bytes | bytes] ifAbsent: [self signalFailure: 'No file!!']! ! !FSWriteStreamTest methodsFor: 'running' stamp: 'cwp 2/19/2011 01:26'! setUp filesystem := FSFilesystem inMemory. stream := filesystem writeStreamOn: 'giffle'! ! !FSWriteStreamTest methodsFor: 'tests' stamp: 'cwp 7/28/2009 22:48'! testClose self shouldnt: [stream close] raise: Error! ! !FSWriteStreamTest methodsFor: 'tests' stamp: 'cwp 7/29/2009 21:55'! testContents stream nextPutAll: #(42 43 44). self assert: stream contents = #(42 43 44) asByteArray! ! !FSWriteStreamTest methodsFor: 'tests' stamp: 'cwp 7/29/2009 21:55'! testCr stream cr. self assert: self contents first = 13! ! !FSWriteStreamTest methodsFor: 'tests' stamp: 'cwp 7/28/2009 22:21'! testFlush self shouldnt: [stream flush] raise: Error! ! !FSWriteStreamTest methodsFor: 'tests' stamp: 'cwp 7/29/2009 21:55'! testNextPut stream nextPut: 42. self assert: self contents first = 42! ! !FSWriteStreamTest methodsFor: 'tests' stamp: 'cwp 7/29/2009 22:23'! testNextPutAll stream nextPutAll: #(42 43 44). stream flush. self assert: self contents = #(42 43 44) asByteArray! ! !FSWriteStreamTest methodsFor: 'tests' stamp: 'MaxLeske 11/14/2010 10:43'! testOverriding stream nextPutAll: 'foo bar'; close. self assert: (filesystem root resolve: 'giffle') readStream contents asString = 'foo bar'. (filesystem root resolve: 'giffle') writeStreamDo: [ :s | s nextPutAll: 'x' ]. self assert: (filesystem referenceTo: 'giffle') readStream contents asString = 'x'! ! !FSWriteStreamTest methodsFor: 'tests' stamp: 'cwp 7/29/2009 21:55'! testSpace stream space. self assert: self contents first = 32! ! !FSWriteStreamTest methodsFor: 'tests' stamp: 'cwp 7/29/2009 21:56'! testTab stream tab. self assert: self contents first = 9! ! !FSWriteStreamTest methodsFor: 'tests' stamp: 'cwp 10/15/2009 22:04'! testTruncate stream nextPutAll: #(42 43 44 45 46); flush; position: 4; truncate. self assert: self contents = #(42 43 44) asByteArray! ! !FSWriteStreamTest methodsFor: 'tests' stamp: 'cwp 10/15/2009 21:50'! testTruncateTo stream nextPutAll: #(42 43 44 45 46). stream flush. stream truncateTo: 3. self assert: self contents = #(42 43 44) asByteArray! ! Object subclass: #FSDirectoryEntry instanceVariableNames: 'reference creation modification isDirectory size' classVariableNames: '' poolDictionaries: '' category: 'Filesystem-Core'! !FSDirectoryEntry commentStamp: 'cwp 11/18/2009 11:09' prior: 0! I am a cache for metadata about a file or directory. The information I hold is as follows: reference A reference to the file or directory to which my data pertains. creation The creation date and time, stored as number seconds since the Smalltalk epoch. modification The modification date and time, number seconds since the Smalltalk epoch. isDirectory True if my data pertains to a directory, false if a file. size Size in bytes for a file, 0 for a directory. ! !FSDirectoryEntry class methodsFor: 'instance creation' stamp: 'StephaneDucasse 1/27/2011 22:22'! filesystem: aFilesystem path: aPath creation: cTime modification: mTime isDir: aBoolean size: anInteger "Create a directory entry given a filesystem and a path in such filesystem. In addition, the creation and modification time are required as well as a boolean that indicates whether the entry is a folder or a file and its size." ^ self reference: (aFilesystem referenceTo: aPath) creation: cTime modification: mTime isDir: aBoolean size: anInteger! ! !FSDirectoryEntry class methodsFor: 'instance creation' stamp: 'StephaneDucasse 1/27/2011 22:19'! reference: ref creation: cTime modification: mTime isDir: aBoolean size: anInteger "Create a directory entry for the file reference ref, with the creation time, cTime, the modification time, mTime. aBoolean indicates if the entry represents a directory or a file of size given by anInteger" ^ self basicNew initializeWithRef: ref creation: cTime modification: mTime isDir: aBoolean size: anInteger! ! !FSDirectoryEntry methodsFor: 'accessing' stamp: 'StephaneDucasse 2/15/2010 17:59'! basename ^ reference basename! ! !FSDirectoryEntry methodsFor: 'accessing' stamp: 'StephaneDucasse 1/27/2011 22:14'! creation "Return the creation date and time of the entry receiver." ^ DateAndTime fromSeconds: creation! ! !FSDirectoryEntry methodsFor: 'accessing' stamp: 'StephaneDucasse 1/27/2011 22:16'! creationSeconds "Return the creation date and time of the entry receiver in seconds." ^ creation! ! !FSDirectoryEntry methodsFor: 'initialize-release' stamp: 'cwp 11/15/2009 21:52'! initializeWithRef: ref creation: cTime modification: mTime isDir: bool size: bytes reference := ref. creation := cTime. modification := mTime. isDirectory := bool. size := bytes! ! !FSDirectoryEntry methodsFor: 'testing' stamp: 'StephaneDucasse 1/27/2011 22:16'! isDirectory "Return whether the receiver is a directory" ^ isDirectory! ! !FSDirectoryEntry methodsFor: 'testing' stamp: 'StephaneDucasse 1/27/2011 22:16'! isFile "Return whether the receiver is a file" ^ isDirectory not! ! !FSDirectoryEntry methodsFor: 'accessing' stamp: 'StephaneDucasse 1/27/2011 22:15'! modification "Return the modification date and time of the entry receiver." ^ DateAndTime fromSeconds: modification! ! !FSDirectoryEntry methodsFor: 'accessing' stamp: 'StephaneDucasse 1/27/2011 22:15'! modificationSeconds "Return the modification date and time of the entry receiver in seconds." ^ modification! ! !FSDirectoryEntry methodsFor: 'printing' stamp: 'sd 2/11/2011 19:40'! printOn: aStream aStream nextPutAll: 'DirectoryEntry: '. reference ifNotNilDo: [:ref | aStream nextPutAll: reference printString].! ! !FSDirectoryEntry methodsFor: 'accessing' stamp: 'cwp 11/15/2009 21:54'! reference ^ reference! ! !FSDirectoryEntry methodsFor: 'accessing' stamp: 'StephaneDucasse 1/27/2011 22:15'! size "Returns the receiver size" ^ size! ! Object subclass: #FSFilePluginPrims instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Filesystem-Disk'! !FSFilePluginPrims commentStamp: 'cwp 11/18/2009 13:02' prior: 0! I provide an interface to the primitives in the FilePlugin. ! !FSFilePluginPrims methodsFor: 'file primitives' stamp: 'cwp 7/20/2009 17:26'! atEnd: id "Answer true if the file position is at the end of the file." self primitiveFailed ! ! !FSFilePluginPrims methodsFor: 'file primitives' stamp: 'cwp 7/20/2009 17:27'! close: id "Close this file." ! ! !FSFilePluginPrims methodsFor: 'path primitives' stamp: 'cwp 11/17/2009 16:26'! createDirectory: fullPath "Create a directory named by the given path. Fail if the path is bad or if a file or directory by that name already exists." ^ nil ! ! !FSFilePluginPrims methodsFor: 'encoding primitives' stamp: 'lr 7/13/2010 14:10'! decode: aString ^ aString convertFromWithConverter: LanguageEnvironment defaultFileNameConverter! ! !FSFilePluginPrims methodsFor: 'path primitives' stamp: 'cwp 7/20/2009 17:21'! deleteDirectory: fullPath "Delete the directory named by the given path. Fail if the path is bad or if a directory by that name does not exist." self primitiveFailed ! ! !FSFilePluginPrims methodsFor: 'path primitives' stamp: 'cwp 7/20/2009 17:22'! deleteFile: aFileName "Delete the file of the given name. Return self if the primitive succeeds, nil otherwise." ^ nil ! ! !FSFilePluginPrims methodsFor: 'path primitives' stamp: 'cwp 10/11/2009 11:02'! delimiter "Return the path delimiter for the underlying platform's file system." self primitiveFailed ! ! !FSFilePluginPrims methodsFor: 'encoding primitives' stamp: 'lr 7/13/2010 14:11'! encode: aString ^ aString convertToWithConverter: LanguageEnvironment defaultFileNameConverter! ! !FSFilePluginPrims methodsFor: 'file primitives' stamp: 'lr 3/21/2010 12:10'! flush: id "Flush pending changes to the disk" | pos | "In some OS's seeking to 0 and back will do a flush" pos := self getPosition: id. self setPosition: id to: 0; setPosition: id to: pos! ! !FSFilePluginPrims methodsFor: 'path primitives' stamp: 'cwp 7/20/2009 17:23'! getMacFile: fileName type: typeString creator: creatorString "Get the Macintosh file type and creator info for the file with the given name. Fails if the file does not exist or if the type and creator type arguments are not strings of length 4. This primitive is Mac specific; it is a noop on other platforms." ! ! !FSFilePluginPrims methodsFor: 'file primitives' stamp: 'cwp 7/20/2009 17:27'! getPosition: id "Get this files current position." self primitiveFailed ! ! !FSFilePluginPrims methodsFor: 'path primitives' stamp: 'cwp 10/11/2009 11:02'! imageFile "Answer the full path name for the current image." self primitiveFailed! ! !FSFilePluginPrims methodsFor: 'path primitives' stamp: 'cwp 7/20/2009 17:24'! lookupEntryIn: fullPath index: index "Look up the index-th entry of the directory with the given fully-qualified path (i.e., starting from the root of the file hierarchy) and return an array containing: The empty string enumerates the top-level files or drives. (For example, on Unix, the empty path enumerates the contents of '/'. On Macs and PCs, it enumerates the mounted volumes/drives.) The creation and modification times are in seconds since the start of the Smalltalk time epoch. DirFlag is true if the entry is a directory. FileSize the file size in bytes or zero for directories. The primitive returns nil when index is past the end of the directory. It fails if the given path is bad." ^ #badDirectoryPath ! ! !FSFilePluginPrims methodsFor: 'file primitives' stamp: 'cwp 7/20/2009 17:27'! open: fileName writable: writableFlag "Open a file of the given name, and return the file ID obtained. If writableFlag is true, then if there is none with this name, then create one else prepare to overwrite the existing from the beginning otherwise if the file exists, open it read-only else return nil" ^ nil ! ! !FSFilePluginPrims methodsFor: 'file primitives' stamp: 'cwp 7/20/2009 17:28'! read: id into: byteArray startingAt: startIndex count: count "Read up to count bytes of data from this file into the given string or byte array starting at the given index. Answer the number of bytes actually read." self primitiveFailed! ! !FSFilePluginPrims methodsFor: 'path primitives' stamp: 'cwp 7/20/2009 17:24'! rename: oldFileFullName to: newFileFullName "Rename the file of the given name to the new name. Fail if there is no file of the old name or if there is an existing file with the new name." ^nil! ! !FSFilePluginPrims methodsFor: 'path primitives' stamp: 'cwp 7/20/2009 17:25'! setMacFileNamed: fileName type: typeString creator: creatorString "Set the Macintosh file type and creator info for the file with the given name. Fails if the file does not exist or if the type and creator type arguments are not strings of length 4. This primitive is Mac specific; it is a noop on other platforms." self primitiveFailed ! ! !FSFilePluginPrims methodsFor: 'file primitives' stamp: 'cwp 7/20/2009 17:30'! setPosition: id to: anInteger "Set this file to the given position." self primitiveFailed ! ! !FSFilePluginPrims methodsFor: 'file primitives' stamp: 'cwp 7/20/2009 17:30'! size: id "Answer the size of this file." self primitiveFailed ! ! !FSFilePluginPrims methodsFor: 'file primitives' stamp: 'cwp 7/22/2009 07:10'! sizeOrNil: id "Answer the size of this file." ^ nil! ! !FSFilePluginPrims methodsFor: 'file primitives' stamp: 'cwp 7/20/2009 17:33'! truncate: id to: anInteger "Truncate this file to the given position." self primitiveFailed ! ! !FSFilePluginPrims methodsFor: 'file primitives' stamp: 'cwp 7/20/2009 17:33'! write: id from: stringOrByteArray startingAt: startIndex count: count "Write count bytes onto this file from the given string or byte array starting at the given index. Answer the number of bytes written." self primitiveFailed! ! Object subclass: #FSFilesystem instanceVariableNames: 'workingDirectory store' classVariableNames: '' poolDictionaries: '' category: 'Filesystem-Core'! FSFilesystem class instanceVariableNames: 'disk'! !FSFilesystem commentStamp: 'cwp 3/25/2011 13:26' prior: 0! I present a low-level protocol for interacting with filesystems. I hold a reference to a store (a subinstance of FSStore) which takes care of the details of performing file and directory operations on the filesystem I represent. I keep track of the current directory, and am responsible for resolving all paths that I pass into my store.! FSFilesystem class instanceVariableNames: 'disk'! !FSFilesystem class methodsFor: 'disk filesystem' stamp: 'cwp 2/19/2011 15:04'! createDiskFilesystem ^ self store: (FSDiskStore current)! ! !FSFilesystem class methodsFor: 'instance creation' stamp: 'cwp 2/18/2011 23:12'! inMemory ^ self store: (FSMemoryStore new)! ! !FSFilesystem class methodsFor: 'instance creation' stamp: 'cwp 2/19/2011 14:44'! inZip: aReference ^ self store: (FSZipStore reference: aReference)! ! !FSFilesystem class methodsFor: 'initializing' stamp: 'cwp 2/19/2011 15:06'! initialize Smalltalk addToStartUpList: self! ! !FSFilesystem class methodsFor: 'disk filesystem' stamp: 'cwp 3/25/2011 13:06'! onDisk "Answer a filesystem that represents the 'on-disk' filesystem used by the host operating system." ^ disk ifNil: [disk := self createDiskFilesystem]! ! !FSFilesystem class methodsFor: 'disk filesystem' stamp: 'cwp 2/19/2011 15:05'! resetDiskFilesystem disk := nil! ! !FSFilesystem class methodsFor: 'initializing' stamp: 'cwp 2/19/2011 15:06'! startUp: resuming resuming ifTrue: [ self resetDiskFilesystem ]! ! !FSFilesystem class methodsFor: 'instance creation' stamp: 'cwp 2/18/2011 20:34'! store: aStore ^ self basicNew initializeWithStore: aStore; yourself! ! !FSFilesystem methodsFor: 'navigating' stamp: 'cwp 3/25/2011 13:04'! / anObject "Return the absolute reference obtained by resolving anObject against the root of this filesystem." ^ self root / anObject! ! !FSFilesystem methodsFor: 'comparing' stamp: 'cwp 2/18/2011 16:08'! = other ^ self species = other species and: [self store = other store]! ! !FSFilesystem methodsFor: 'private' stamp: 'cwp 3/25/2011 13:14'! basicOpen: aResolvable writable: aBoolean | path | path := self resolve: aResolvable. ^ store basicOpen: path writable: aBoolean! ! !FSFilesystem methodsFor: 'accessing' stamp: 'cwp 3/29/2011 15:58'! changeDirectory: aPath self workingDirectoryPath: (self resolve: aPath)! ! !FSFilesystem methodsFor: 'public' stamp: 'cwp 3/25/2011 13:13'! childrenAt: aResolvable | path | path := self resolve: aResolvable. ^ Array streamContents: [ :out | store directoryAt: path ifAbsent: [ store directoryDoesNotExist: path ] nodesDo: [ :entry | out nextPut: path / (store basenameFromEntry: entry) ] ]! ! !FSFilesystem methodsFor: 'public' stamp: 'cwp 2/19/2011 01:39'! close store close! ! !FSFilesystem methodsFor: 'public' stamp: 'cwp 3/29/2011 15:39'! copy: sourcePath ifAbsent: aBlock to: destPath ifPresent: pBlock "Copy the file referenced as sourcePath to the destination referred as destPath. Perform associate actions in case of problems." | source destination | source := self resolve: sourcePath. destination := self resolve: destPath. store basicCopy: source ifAbsent: aBlock to: destination ifPresent: pBlock filesystem: self! ! !FSFilesystem methodsFor: 'public' stamp: 'cwp 3/25/2011 19:13'! copy: sourcePath to: destPath "Copy the file referenced as sourcePath to the destination referred as destPath. If there is no file at sourcePath, raise FileDoesNotExist. If destPath is a file, raise FileExists." self copy: sourcePath ifAbsent: [ store fileDoesNotExist: sourcePath ] to: destPath ifPresent: [ store fileExists: destPath ]! ! !FSFilesystem methodsFor: 'private' stamp: 'cwp 2/18/2011 14:25'! copy: aPath toReference: destRef | in path | path := self resolve: aPath. [in := self readStreamOn: path. in ifNil: [ store fileDoesNotExist: path ]. destRef filesystem copyFrom: in to: destRef path ] ensure: [ in ifNotNil: [ in close ] ]! ! !FSFilesystem methodsFor: 'private' stamp: 'cwp 2/18/2011 14:26'! copyFrom: in to: destPath | buffer out | out := nil. (self exists: destPath) ifTrue: [ store fileExists: destPath ]. ^ [ out := self writeStreamOn: destPath. buffer := ByteArray new: 1024. [ in atEnd ] whileFalse: [ buffer := in nextInto: buffer. out nextPutAll: buffer ] ] ensure: [ out ifNotNil: [ out close ] ]! ! !FSFilesystem methodsFor: 'public' stamp: 'cwp 3/25/2011 13:15'! createDirectory: aResolvable "Resolve aResolvable into an absolute path, then as the store to create a directory there. The store is expected to raise an exception if it cannot do so." ^ store createDirectory: (self resolve: aResolvable)! ! !FSFilesystem methodsFor: 'public' stamp: 'cwp 3/25/2011 13:14'! delete: aResolvable store delete: (self resolve: aResolvable)! ! !FSFilesystem methodsFor: 'public' stamp: 'cwp 3/25/2011 19:14'! delimiter "Return path delimiter used by this filesystem." ^ store delimiter! ! !FSFilesystem methodsFor: 'public' stamp: 'cwp 3/25/2011 19:16'! ensureDirectory: aResolvable "Resolve the argument to an absolute path, then ask the store to make sure that all the directories contained in the argument path exist or are created." store ensureDirectory: (self resolve: aResolvable)! ! !FSFilesystem methodsFor: 'public' stamp: 'cwp 3/25/2011 13:15'! entriesAt: aResolvable | path entry aFilesystem | path := self resolve: aResolvable. aFilesystem := self. ^ Array streamContents: [ :out | store directoryAt: path ifAbsent: [ store directoryDoesNotExist: path ] nodesDo: [ :node | entry := store entryFromNode: node path: path for: aFilesystem. out nextPut: entry ] ]! ! !FSFilesystem methodsFor: 'public' stamp: 'cwp 3/25/2011 13:15'! entryAt: aResolvable | path | path := self resolve: aResolvable. ^ store nodeAt: path ifPresent: [ :node | store entryFromNode: node filesystem: self path: path ] ifAbsent: [ store fileDoesNotExist: path ]! ! !FSFilesystem methodsFor: 'public' stamp: 'cwp 3/25/2011 19:19'! exists: aResolvable "Resolve the argument, and answer true if the there is a file or directory at that path, false if there is not." ^ store exists: (self resolve: aResolvable)! ! !FSFilesystem methodsFor: 'printing' stamp: 'cwp 2/18/2011 16:34'! forReferencePrintOn: aStream store forReferencePrintOn: aStream! ! !FSFilesystem methodsFor: 'comparing' stamp: 'cwp 2/18/2011 16:08'! hash ^ store hash! ! !FSFilesystem methodsFor: 'initialize-release' stamp: 'cwp 2/18/2011 20:33'! initializeWithStore: aStore store := aStore. workingDirectory := store defaultWorkingDirectory! ! !FSFilesystem methodsFor: 'public' stamp: 'cwp 3/25/2011 19:21'! isDirectory: aResolvable "Resolve the argument, and answer true if the result refers to a directory, false if it refers to a file or doesn't exist." ^ store isDirectory: (self resolve: aResolvable)! ! !FSFilesystem methodsFor: 'public' stamp: 'cwp 3/25/2011 19:23'! isFile: aResolvable "Resolve the argument, and answer true if the result refers to a file, false if it refers to a directory or doesn't exist." | path | path := self resolve: aResolvable. ^ store isFile: path! ! !FSFilesystem methodsFor: 'public' stamp: 'cwp 3/25/2011 19:23'! open "Some kinds of filesystems need to open connections to external resources. Does nothing by default." store open! ! !FSFilesystem methodsFor: 'public' stamp: 'cwp 3/25/2011 13:22'! open: aResolvable writable: aBoolean "Resolve aResolvable into an absolute path, then ask the store to open the file at that path using the specified access mode." | path | path := self resolve: aResolvable. ^ store handleClass open: (FSReference filesystem: self path: path) writable: aBoolean ! ! !FSFilesystem methodsFor: 'delegated' stamp: 'cwp 3/25/2011 13:16'! openFileStream: aResolvable writable: aBoolean ^ store openFileStream: (self resolve: aResolvable) writable: aBoolean! ! !FSFilesystem methodsFor: 'converting' stamp: 'cwp 11/21/2009 11:30'! pathFromObject: anObject ^ anObject asPathWith: self! ! !FSFilesystem methodsFor: 'converting' stamp: 'cwp 2/18/2011 16:39'! pathFromString: aString ^ store pathFromString: aString! ! !FSFilesystem methodsFor: 'printing' stamp: 'cwp 2/28/2011 12:29'! printPath: aPath on: aStream store printPath: aPath on: aStream! ! !FSFilesystem methodsFor: 'public' stamp: 'cwp 3/29/2011 15:42'! readStreamOn: aResolvable "Resolve the argument into an absolute path and open a file handle on the file at that path. Ask the handle to give us a read stream for reading the file." ^ (self open: aResolvable writable: false) readStream.! ! !FSFilesystem methodsFor: 'public' stamp: 'cwp 3/29/2011 15:44'! referenceTo: aResolvable "Answer a reference to the argument from the context of the receiver filesystem. Example: FSFilesystem onDisk referenceTo: 'plonk.taz'" ^ FSReference filesystem: self path: (self pathFromObject: aResolvable)! ! !FSFilesystem methodsFor: 'public' stamp: 'cwp 3/29/2011 15:47'! rename: sourcePath as: destName "Rename the file referenced as sourcePath to destPath. Raise exceptions FileExists or FileDoesNotExist if the operation fails" ^ self rename: sourcePath ifAbsent: [store fileDoesNotExist: sourcePath] as: destName ifPresent: [self fileExists: destName]! ! !FSFilesystem methodsFor: 'public' stamp: 'cwp 3/29/2011 15:53'! rename: sourcePath ifAbsent: aBlock as: destPath ifPresent: pBlock "Rename the file referenced as sourcePath to the destination referred as destPath. Perform associate actions in case of problems." | source destination | source := self resolve: sourcePath. destination := self resolve: destPath. self basicRename: source ifAbsent: aBlock as: destination ifPresent: pBlock! ! !FSFilesystem methodsFor: 'public' stamp: 'cwp 3/29/2011 15:54'! resolve: aResolvable ^ aResolvable asResolvedBy: self! ! !FSFilesystem methodsFor: 'navigating' stamp: 'cwp 3/29/2011 15:54'! resolvePath: aPath "Return a path where the argument is resolved in the context of the receiver. The behavior is similar to the one of a command line. > cd /a/b/c > cd b The shell will attempt to make /a/b/c/b the current directory. " ^ workingDirectory resolve: aPath! ! !FSFilesystem methodsFor: 'navigating' stamp: 'cwp 10/10/2009 17:32'! resolveReference: aReference ^ aReference filesystem = self ifTrue: [workingDirectory resolvePath: aReference path]! ! !FSFilesystem methodsFor: 'navigating' stamp: 'cwp 3/29/2011 15:56'! resolveString: aString "Returns the root of the receiver filesystem, i.e. / on unix" ^ workingDirectory resolvePath: (store pathFromString: aString)! ! !FSFilesystem methodsFor: 'accessing' stamp: 'cwp 9/20/2009 22:27'! root ^ self referenceTo: FSPath root! ! !FSFilesystem methodsFor: 'accessing' stamp: 'cwp 2/18/2011 16:08'! store ^ store! ! !FSFilesystem methodsFor: 'converting' stamp: 'cwp 2/18/2011 12:09'! stringFromPath: aPath ^ store stringFromPath: aPath! ! !FSFilesystem methodsFor: 'accessing' stamp: 'lr 2/14/2010 09:48'! working ^ self referenceTo: self workingDirectory! ! !FSFilesystem methodsFor: 'accessing' stamp: 'sd 2/11/2011 18:23'! workingDirectory "Returns a reference to the directory from where the image was launched" ^ self referenceTo: self workingDirectoryPath! ! !FSFilesystem methodsFor: 'accessing' stamp: 'cwp 3/29/2011 15:57'! workingDirectoryPath ^ workingDirectory! ! !FSFilesystem methodsFor: 'accessing' stamp: 'cwp 3/29/2011 15:58'! workingDirectoryPath: aPath aPath isAbsolute ifFalse: [self error: 'Cannot set the working directory to a relative path']. workingDirectory := aPath ! ! !FSFilesystem methodsFor: 'public' stamp: 'cwp 3/29/2011 16:01'! writeStreamOn: aResolvable "Open a write stream on the file referred by the argument. It can be a string or a path" ^ (self open: aResolvable writable: true) writeStream.! ! Object subclass: #FSGuide instanceVariableNames: 'visitor work' classVariableNames: '' poolDictionaries: '' category: 'Filesystem-Enumeration'! !FSGuide commentStamp: 'cwp 11/18/2009 12:09' prior: 0! I am an abstract superclass for objects that fulfill the Guide role in the Guide/Visitor pattern. My subclasses know how to traverse a filesystem in a specific order, "showing" the files and directories they encounter to a visitor. visitor An object that fulfills the Visitor role and implements the visitor protocol. work An OrderedCollection, used to keep track of filesystem nodes that have not yet been visited! FSGuide subclass: #FSBreadthFirstGuide instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Filesystem-Enumeration'! !FSBreadthFirstGuide commentStamp: 'cwp 11/18/2009 12:13' prior: 0! I traverse the filesystem in breadth-first order. Given this hierarchy: alpha beta gamma delta epsilon I would visit the nodes in the following order: alpha, delta, beta, gamma, epsilon. I use my work instance variable as a queue, adding nodes to be visited to the end and retrieving them from the beginning. ! !FSBreadthFirstGuide methodsFor: 'showing' stamp: 'cwp 11/16/2009 10:42'! show: aReference | entry | work add: aReference entry. self whileNotDoneDo: [entry := work removeFirst. entry isFile ifTrue: [ visitor visitFile: entry] ifFalse: [visitor visitDirectory: entry. work addAll: entry reference entries]]! ! !FSGuide class methodsFor: 'instance creation' stamp: 'cwp 10/29/2009 19:27'! for: aVisitor ^ self basicNew initializeWithVisitor: aVisitor! ! !FSGuide class methodsFor: 'instance creation' stamp: 'cwp 11/17/2009 11:58'! show: aReference to: aVisitor ^ (self for: aVisitor) show: aReference! ! !FSGuide methodsFor: 'initialize-release' stamp: 'StephaneDucasse 1/27/2011 10:37'! initialize super initialize. work := OrderedCollection new! ! !FSGuide methodsFor: 'initialize-release' stamp: 'cwp 10/29/2009 23:48'! initializeWithVisitor: aVisitor self initialize. visitor := aVisitor. ! ! !FSGuide methodsFor: 'showing' stamp: 'cwp 10/29/2009 23:21'! show: aReference self subclassResponsibility! ! !FSGuide methodsFor: 'showing' stamp: 'lr 7/13/2010 15:36'! whileNotDoneDo: aBlock [ work isEmpty ] whileFalse: [ aBlock value ]! ! FSGuide subclass: #FSPostorderGuide instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Filesystem-Enumeration'! !FSPostorderGuide commentStamp: 'cwp 11/18/2009 12:16' prior: 0! I traverse the filesystem in depth-first post order. Given this hierarchy: alpha beta gamma delta epsilon I would visit the nodes in the following order: beta, gamma, alpha, epsilon, delta. I use my work instance variable as a stack. I push messages that cause nodes to be traversed or visited, and execute them in reverse order.! !FSPostorderGuide methodsFor: 'showing' stamp: 'cwp 10/29/2009 23:51'! pop ^ work removeLast! ! !FSPostorderGuide methodsFor: 'showing' stamp: 'cwp 11/14/2009 22:41'! pushTraverse: aReference work add: (Message selector: #traverse: argument: aReference)! ! !FSPostorderGuide methodsFor: 'showing' stamp: 'cwp 11/14/2009 22:42'! pushVisit: aReference work add: (Message selector: #visit: argument: aReference)! ! !FSPostorderGuide methodsFor: 'showing' stamp: 'cwp 11/16/2009 10:50'! show: aReference self pushTraverse: aReference entry. self whileNotDoneDo: [self pop sendTo: self ]! ! !FSPostorderGuide methodsFor: 'showing' stamp: 'cwp 11/16/2009 21:57'! traverse: anEntry self pushVisit: anEntry. anEntry isDirectory ifTrue: [anEntry reference entries reverseDo: [:ea | self pushTraverse: ea]]! ! !FSPostorderGuide methodsFor: 'showing' stamp: 'cwp 11/16/2009 10:50'! visit: anEntry anEntry isDirectory ifTrue: [visitor visitDirectory: anEntry] ifFalse: [visitor visitFile: anEntry] ! ! FSGuide subclass: #FSPreorderGuide instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Filesystem-Enumeration'! !FSPreorderGuide commentStamp: 'cwp 11/18/2009 12:18' prior: 0! I traverse the filesystem in depth-first pre order. Given this hierarchy: alpha beta gamma delta epsilon I would visit the nodes in the following order: alpha, beta, gamma, delta, epsilon. I use my work instance variable as a stack. I push nodes to be visited and visit them in reverse order.! !FSPreorderGuide methodsFor: 'showing' stamp: 'cwp 10/29/2009 23:51'! pop ^ work removeLast! ! !FSPreorderGuide methodsFor: 'showing' stamp: 'cwp 11/15/2009 22:24'! push: anObject work add: anObject! ! !FSPreorderGuide methodsFor: 'showing' stamp: 'cwp 10/29/2009 23:51'! pushAll: aCollection aCollection reverseDo: [ :ea | work add: ea ]! ! !FSPreorderGuide methodsFor: 'showing' stamp: 'cwp 11/16/2009 10:47'! show: aReference self push: aReference entry. self whileNotDoneDo: [| entry | entry := self pop. entry isFile ifTrue: [visitor visitFile: entry] ifFalse: [visitor visitDirectory: entry. self pushAll: entry reference entries]]! ! Object subclass: #FSHandle instanceVariableNames: 'reference writable' classVariableNames: 'Primitives' poolDictionaries: '' category: 'Filesystem-Core'! !FSHandle commentStamp: 'cwp 11/18/2009 11:11' prior: 0! I am an abstract superclass for file handle implementations. I provide a uniform interface that streams can use for read and write operations on a file regardless of the filesystem. I encapsulate the actual IO primitives.! FSHandle subclass: #FSFileHandle instanceVariableNames: 'id' classVariableNames: '' poolDictionaries: '' category: 'Filesystem-Disk'! !FSFileHandle commentStamp: 'cwp 11/18/2009 13:02' prior: 0! I provide an interface for doing IO on an open file. I keep an id, which as an opaque identifier used by the FilePlugin primitives. I translate positions from the 1-based indexes used in Smalltalk to the 0-based offsets used by the primitives. I do not implement the primitives myself, instead delegating those to an instance of FilePluginPrimitives.! !FSFileHandle class methodsFor: 'class initialization' stamp: 'cwp 11/20/2009 16:16'! initialize self useFilePlugin. ! ! !FSFileHandle class methodsFor: 'class initialization' stamp: 'cwp 11/20/2009 16:51'! startUp: resuming "This functionality is disabled for now, to avoid doing a lot of processing at image start up. To reenable, add this class to the start up list." resuming ifTrue: [self allInstancesDo: [:ea | ea startUp]]! ! !FSFileHandle class methodsFor: 'class initialization' stamp: 'cwp 7/22/2009 07:11'! useFilePlugin Primitives := FSFilePluginPrims new! ! !FSFileHandle methodsFor: 'public' stamp: 'cwp 7/31/2009 00:05'! at: index read: buffer startingAt: start count: count ^ Primitives setPosition: id to: index - 1; read: id into: buffer startingAt: start count: count ! ! !FSFileHandle methodsFor: 'public' stamp: 'cwp 7/26/2009 14:15'! at: index write: buffer startingAt: start count: count Primitives setPosition: id to: index - 1; write: id from: buffer startingAt: start count: count ! ! !FSFileHandle methodsFor: 'private' stamp: 'cwp 11/20/2009 14:38'! basicOpen id := reference filesystem basicOpen: reference path writable: writable! ! !FSFileHandle methodsFor: 'public' stamp: 'cwp 11/20/2009 14:59'! close Primitives close: id. id := nil! ! !FSFileHandle methodsFor: 'public' stamp: 'cwp 7/22/2009 07:49'! flush Primitives flush: id! ! !FSFileHandle methodsFor: 'testing' stamp: 'cwp 7/22/2009 07:10'! isOpen ^ (Primitives sizeOrNil: id) notNil! ! !FSFileHandle methodsFor: 'public' stamp: 'cwp 11/20/2009 14:38'! open self basicOpen. id ifNil: [(writable or: [reference exists]) ifTrue: [self error: 'Unable to open file ' , reference printString] ifFalse: [FSFileDoesNotExist signalWith: reference]]! ! !FSFileHandle methodsFor: 'public' stamp: 'cwp 7/22/2009 07:44'! size ^ Primitives size: id! ! !FSFileHandle methodsFor: 'private' stamp: 'cwp 11/20/2009 16:48'! startUp "This functionality is disabled for now, to avoid doing lots of processing on start up." "We're starting up in a new OS process, so the file id will be invalid. Try to reopen the file, but fail silently: just leave the id as nil. #isOpen will answer false, and we'll raise an error if anyone tries to do IO." self basicOpen! ! !FSFileHandle methodsFor: 'public' stamp: 'cwp 7/22/2009 08:17'! truncateTo: anInteger Primitives truncate: id to: anInteger. self reopen! ! !FSHandle class methodsFor: 'instance creation' stamp: 'cwp 7/26/2009 12:52'! on: aReference writable: aBoolean ^ self new setReference: aReference writable: aBoolean! ! !FSHandle class methodsFor: 'instance creation' stamp: 'cwp 7/26/2009 12:52'! open: aReference writable: aBoolean ^ (self on: aReference writable: aBoolean) open! ! !FSHandle methodsFor: 'public' stamp: 'cwp 7/29/2009 22:19'! at: index | buffer | buffer := ByteArray new: 1. self at: index read: buffer startingAt: 1 count: 1. ^ buffer at: 1! ! !FSHandle methodsFor: 'public' stamp: 'lr 4/13/2010 16:10'! at: index put: anObject | buffer | buffer := ByteArray with: (anObject isCharacter ifTrue: [ anObject codePoint ] ifFalse: [ anObject ]). self at: index write: buffer startingAt: 1 count: 1. ! ! !FSHandle methodsFor: 'public' stamp: 'cwp 7/26/2009 12:50'! at: offset read: buffer startingAt: start count: count self subclassResponsibility! ! !FSHandle methodsFor: 'public' stamp: 'cwp 7/26/2009 12:50'! at: offset write: buffer startingAt: start count: count self subclassResponsibility! ! !FSHandle methodsFor: 'public' stamp: 'cwp 7/26/2009 12:50'! close self subclassResponsibility! ! !FSHandle methodsFor: 'public' stamp: 'cwp 7/26/2009 12:50'! flush self subclassResponsibility! ! !FSHandle methodsFor: 'testing' stamp: 'cwp 7/26/2009 12:50'! isOpen self subclassResponsibility! ! !FSHandle methodsFor: 'public' stamp: 'cwp 7/26/2009 12:50'! open self subclassResponsibility! ! !FSHandle methodsFor: 'public' stamp: 'cwp 7/31/2009 00:32'! readStream ^ self isOpen ifTrue: [FSReadStream onHandle: self]! ! !FSHandle methodsFor: 'accessing' stamp: 'cwp 7/26/2009 12:51'! reference ^ reference! ! !FSHandle methodsFor: 'public' stamp: 'cwp 7/26/2009 12:51'! reopen self close. self open! ! !FSHandle methodsFor: 'initialize-release' stamp: 'cwp 11/20/2009 14:56'! setReference: aReference writable: aBoolean reference := aReference resolve. writable := aBoolean! ! !FSHandle methodsFor: 'public' stamp: 'cwp 7/26/2009 12:50'! truncateTo: anInteger self subclassResponsibility! ! !FSHandle methodsFor: 'public' stamp: 'cwp 7/28/2009 23:06'! writeStream ^ FSWriteStream onHandle: self! ! FSHandle subclass: #FSMemoryHandle instanceVariableNames: 'bytes size' classVariableNames: '' poolDictionaries: '' category: 'Filesystem-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! ! Object subclass: #FSLocator instanceVariableNames: 'origin path' classVariableNames: 'Resolver' poolDictionaries: '' category: 'Filesystem-Core'! !FSLocator commentStamp: 'cwp 3/29/2011 16:12' prior: 0! "I am a late-bound reference. I refer to a file or directory in relation to a well-known location on the filesystem, called an origin. When asked to perform concrete operation, I look up the current location of my origin, and resolve my path against it. Usage ---------- FSLocator desktop. FSLocator desktop basename. FSLocator home basename. FSLocator image. FSLocator vmBinary asAbsolute pathString > '/Applications/Squeak' FSLocator vmBinary pathString > '/Applications/Squeak' FSLocator vmDirectory parent pathString > '/Applications' Implementation ------------------------ origin A symbolic name for base reference I use to resolve myself. path A relative path that is resolved against my origin"! !FSLocator class methodsFor: 'class initialization' stamp: 'cwp 10/26/2009 20:54'! addResolver: aResolver Resolver addResolver: aResolver! ! !FSLocator class methodsFor: 'origins' stamp: 'lr 7/13/2010 13:29'! changes ^ self origin: #changes ! ! !FSLocator class methodsFor: 'origins' stamp: 'cwp 10/27/2009 10:24'! desktop ^ self origin: #desktop! ! !FSLocator class methodsFor: 'class initialization' stamp: 'cwp 10/27/2009 10:28'! flushCaches Resolver flushCaches! ! !FSLocator class methodsFor: 'origins' stamp: 'cwp 10/27/2009 09:34'! home ^ self origin: #home! ! !FSLocator class methodsFor: 'origins' stamp: 'cwp 10/25/2009 09:54'! image ^ self origin: #image ! ! !FSLocator class methodsFor: 'origins' stamp: 'lr 7/13/2010 13:35'! imageDirectory ^ self origin: #imageDirectory ! ! !FSLocator class methodsFor: 'class initialization' stamp: 'cwp 11/20/2009 15:01'! initialize Smalltalk addToStartUpList: self. self startUp: true! ! !FSLocator class methodsFor: 'instance creation' stamp: 'cwp 2/26/2011 18:22'! origin: aSymbol ^ self origin: aSymbol path: FSPath workingDirectory! ! !FSLocator class methodsFor: 'instance creation' stamp: 'cwp 10/25/2009 09:56'! origin: aSymbol path: aPath ^ self basicNew initializeWithOrigin: aSymbol path: aPath! ! !FSLocator class methodsFor: 'class initialization' stamp: 'lr 7/13/2010 15:19'! startUp: resuming resuming ifFalse: [ ^ self ]. Resolver := FSInteractiveResolver new. Resolver addResolver: FSSystemResolver new. Resolver addResolver: FSPlatformResolver forCurrentPlatform! ! !FSLocator class methodsFor: 'accessing' stamp: 'cwp 10/27/2009 11:25'! supportedOrigins | origins current | origins := IdentitySet new. current := Resolver. [current notNil] whileTrue: [origins addAll: current supportedOrigins. current := current next]. ^ origins! ! !FSLocator class methodsFor: 'origins' stamp: 'cwp 10/26/2009 11:37'! vmBinary ^ self origin: #vmBinary! ! !FSLocator class methodsFor: 'origins' stamp: 'cwp 10/26/2009 13:49'! vmDirectory ^ self origin: #vmDirectory! ! !FSLocator methodsFor: 'navigating' stamp: 'cwp 10/25/2009 11:12'! , extension ^ self withPath: path, extension! ! !FSLocator methodsFor: 'navigating' stamp: 'cwp 10/25/2009 11:03'! / aString ^ self withPath: (path / aString)! ! !FSLocator methodsFor: 'comparing' stamp: 'cwp 10/26/2009 10:28'! = other ^ self species = other species and: [origin = other origin and: [path = other path]]! ! !FSLocator methodsFor: 'delegated' stamp: 'cwp 11/15/2009 21:23'! allChildren ^ self resolve allChildren! ! !FSLocator methodsFor: 'delegated' stamp: 'cwp 11/16/2009 21:19'! allEntries ^ self resolve allEntries! ! !FSLocator methodsFor: 'converting' stamp: 'cwp 10/25/2009 10:30'! asAbsolute ^ self ! ! !FSLocator methodsFor: 'delegated' stamp: 'cwp 10/26/2009 02:09'! asPathWith: anObject ^ self resolve asPathWith: anObject! ! !FSLocator methodsFor: 'delegated' stamp: 'cwp 10/25/2009 11:09'! basename ^ self resolve basename! ! !FSLocator methodsFor: 'delegated' stamp: 'cwp 11/15/2009 21:24'! children ^ self resolve children! ! !FSLocator methodsFor: 'comparing' stamp: 'cwp 10/25/2009 22:26'! contains: anObject ^ self resolve contains: anObject! ! !FSLocator methodsFor: 'delegated' stamp: 'cwp 11/15/2009 08:10'! copyAllTo: aReference ^ self resolve copyAllTo: aReference! ! !FSLocator methodsFor: 'delegated' stamp: 'cwp 10/26/2009 02:02'! copyTo: aReference ^ self resolve copyTo: aReference resolve! ! !FSLocator methodsFor: 'delegated' stamp: 'cwp 10/26/2009 02:03'! delete ^ self resolve delete! ! !FSLocator methodsFor: 'delegated' stamp: 'cwp 11/15/2009 08:11'! deleteAll ^ self resolve deleteAll! ! !FSLocator methodsFor: 'delegated' stamp: 'cwp 10/26/2009 02:03'! ensureDirectory ^ self resolve ensureDirectory! ! !FSLocator methodsFor: 'delegated' stamp: 'cwp 10/26/2009 02:03'! exists ^ self resolve exists! ! !FSLocator methodsFor: 'delegated' stamp: 'cwp 10/26/2009 02:04'! fileStreamDo: aBlock ^ self resolve fileStreamDo: aBlock! ! !FSLocator methodsFor: 'delegated' stamp: 'cwp 10/25/2009 22:12'! filesystem ^ self resolve filesystem! ! !FSLocator methodsFor: 'delegated' stamp: 'sd 2/11/2011 20:36'! fullName ^ self resolve fullName! ! !FSLocator methodsFor: 'comparing' stamp: 'cwp 10/25/2009 11:05'! hash ^ origin hash bitXor: path hash! ! !FSLocator methodsFor: 'initialize-release' stamp: 'cwp 10/25/2009 09:56'! initializeWithOrigin: aSymbol path: aPath self initialize. origin := aSymbol. path := aPath.! ! !FSLocator methodsFor: 'testing' stamp: 'cwp 10/25/2009 10:30'! isAbsolute ^ true! ! !FSLocator methodsFor: 'comparing' stamp: 'cwp 11/16/2009 09:07'! isChildOf: anObject ^ self resolve isChildOf: anObject! ! !FSLocator methodsFor: 'delegated' stamp: 'cwp 10/25/2009 23:05'! isContainedBy: anObject ^ self resolve isContainedBy: anObject! ! !FSLocator methodsFor: 'delegated' stamp: 'cwp 10/26/2009 02:04'! isDirectory ^ self resolve isDirectory! ! !FSLocator methodsFor: 'delegated' stamp: 'cwp 10/26/2009 02:04'! isFile ^ self resolve isFile! ! !FSLocator methodsFor: 'testing' stamp: 'cwp 10/25/2009 11:15'! isRelative ^ false! ! !FSLocator methodsFor: 'delegated' stamp: 'cwp 10/25/2009 11:22'! isRoot ^ self resolve isRoot! ! !FSLocator methodsFor: 'accessing' stamp: 'cwp 10/25/2009 21:31'! origin ^ origin! ! !FSLocator methodsFor: 'navigating' stamp: 'cwp 10/25/2009 11:27'! parent ^ self withPath: path parent! ! !FSLocator methodsFor: 'accessing' stamp: 'cwp 10/25/2009 21:31'! path ^ path! ! !FSLocator methodsFor: 'delegated' stamp: 'cwp 10/26/2009 02:05'! pathString ^ self resolve pathString! ! !FSLocator methodsFor: 'printing' stamp: 'lr 7/13/2010 15:19'! printOn: aStream | fs | aStream nextPut: ${; nextPutAll: origin; nextPut: $}. path isWorkingDirectory ifTrue: [ ^ self ]. fs := self filesystem. aStream nextPut: fs delimiter. fs printPath: path on: aStream! ! !FSLocator methodsFor: 'delegated' stamp: 'cwp 10/26/2009 02:05'! readStream ^ self resolve readStream! ! !FSLocator methodsFor: 'delegated' stamp: 'cwp 10/26/2009 02:05'! readStreamDo: aBlock ^ self resolve readStreamDo: aBlock! ! !FSLocator methodsFor: 'delegated' stamp: 'cwp 10/29/2009 11:23'! readStreamDo: doBlock ifAbsent: aBlock ^ self resolve readStreamDo: doBlock ifAbsent: aBlock! ! !FSLocator methodsFor: 'delegated' stamp: 'cwp 10/29/2009 11:24'! readStreamIfAbsent: aBlock ^ self resolve readStream readStreamIfAbsent: aBlock! ! !FSLocator methodsFor: 'navigating' stamp: 'cwp 10/25/2009 09:59'! resolve ^ (Resolver resolve: origin) resolve: path! ! !FSLocator methodsFor: 'navigating' stamp: 'cwp 10/26/2009 01:03'! resolve: anObject ^ anObject asResolvedBy: self! ! !FSLocator methodsFor: 'navigating' stamp: 'cwp 10/25/2009 21:36'! resolvePath: aPath ^ self withPath: (path resolvePath: aPath)! ! !FSLocator methodsFor: 'navigating' stamp: 'cwp 10/25/2009 21:53'! resolveReference: aReference ^ aReference isAbsolute ifTrue: [aReference] ifFalse: [self withPath: aReference path]! ! !FSLocator methodsFor: 'navigating' stamp: 'cwp 11/21/2009 11:30'! resolveString: aString | filesystem thePath | filesystem := (Resolver resolve: origin) filesystem. thePath := filesystem pathFromString: aString. ^ self withPath: (path resolvePath: thePath)! ! !FSLocator methodsFor: 'navigating' stamp: 'cwp 11/18/2009 00:01'! withExtension: aString ^ self withPath: (path withExtension: aString)! ! !FSLocator methodsFor: 'navigating' stamp: 'cwp 10/25/2009 11:03'! withPath: newPath ^ path == newPath ifTrue: [self] ifFalse: [self class origin: origin path: newPath]! ! !FSLocator methodsFor: 'delegated' stamp: 'cwp 10/26/2009 02:05'! writeStream ^ self resolve writeStream! ! !FSLocator methodsFor: 'delegated' stamp: 'cwp 10/26/2009 02:06'! writeStreamDo: aBlock ^ self resolve writeStreamDo: aBlock! ! !FSLocator methodsFor: 'delegated' stamp: 'cwp 10/29/2009 11:24'! writeStreamDo: doBlock ifPresent: pBlock ^ self resolve writeStreamDo: doBlock ifPresent: pBlock! ! !FSLocator methodsFor: 'delegated' stamp: 'cwp 10/29/2009 11:23'! writeStreamIfPresent: aBlock ^ self resolve writeStreamIfPresent: aBlock! ! Object variableSubclass: #FSPath instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Filesystem-Core'! !FSPath commentStamp: 'cwp 3/29/2011 16:16' prior: 0! I'm a private and abstract filesystem path, independent of the string representation used to describe paths on a specific filesystem. I provide methods for navigating the filesystem hierarchy and working with absolute and relative paths. I only refer to a concrete file or directory with regard to a specific filesystem. Normally users should not use me directly. Path independent representation of delimiter is defined by FSDiskFilesystem current delimiter. API instance creation: #* and #/ are mnemonic to . and / whose arguments should be string file- or directory names, not fragments of Unix path notation intended to be parsed. #/ and #* provide a mini-DSL for building up paths, while #readFrom:delimiter: parses path strings. Note that (FSPath with: 'parent/child/') isRelative returns true because it creates to a relative path to a file/directory called 'parent/child'. In bash you'd escape the slashes like this: parent\/child\/ similarly (FSPath with: '/parent/child/') isRelative returns true That's a relative path to '/parent/child'. In bash: /\parent\/child\/ (FSPath with: '') isRelative returns false Because this is an absolute path to the root of the file system. Absolute paths have an empty first element. If you consider $/ the separator, '/usr/local/bin' has an empty first element. ! FSPath variableSubclass: #FSAbsolutePath instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Filesystem-Core'! !FSAbsolutePath methodsFor: 'testing' stamp: 'cwp 2/26/2011 10:58'! isAbsolute ^ true! ! !FSAbsolutePath methodsFor: 'testing' stamp: 'cwp 2/26/2011 11:03'! isRoot ^ self size = 0! ! !FSAbsolutePath methodsFor: 'printing' stamp: 'cwp 2/27/2011 09:25'! printOn: aStream aStream nextPutAll: 'FSPath'. self isRoot ifTrue: [aStream nextPutAll: ' root'] ifFalse: [1 to: self size do: [:i | aStream nextPutAll: ' / '''; nextPutAll: (self at: i); nextPut: $']]! ! !FSAbsolutePath methodsFor: 'enumerating' stamp: 'cwp 3/29/2011 16:44'! withParents ^ super withParents addFirst: (FSPath root); yourself! ! !FSPath class methodsFor: 'instance creation' stamp: 'cwp 3/25/2011 20:36'! * aString "Answer a relative path with aString as its sole segment. For example, FSPath * 'griffle' will produce the same result as ./griffle in a unix shell. The selector #* was chosen for it's visual similarity to $." "Note: aString is not parsed, so supplying a string like '/griffle/plonk' will not create an absolute path." ^ FSRelativePath with: aString! ! !FSPath class methodsFor: 'instance creation' stamp: 'cwp 3/25/2011 20:51'! / aString "Answer an absolute path with aString as it's sole segment. The selector was chosen to allow path construction with Smalltalk syntax, which neverthelesss resembles paths as they appear in a unix shell. Eg. FSPath / 'griffle' / 'plonk'." ^ FSAbsolutePath with: aString! ! !FSPath class methodsFor: 'private' stamp: 'cwp 10/26/2009 13:42'! addElement: element to: result element = '..' ifTrue: [^ self addParentElementTo: result]. element = '' ifTrue: [^ self addEmptyElementTo: result]. element = '.' ifFalse: [result add: element]! ! !FSPath class methodsFor: 'private' stamp: 'cwp 10/26/2009 13:41'! addEmptyElementTo: result result isEmpty ifTrue: [result add: ''] ! ! !FSPath class methodsFor: 'private' stamp: 'cwp 10/26/2009 13:39'! addParentElementTo: result result isEmpty ifTrue: [result add: '..'] ifFalse: [result removeLast] ! ! !FSPath class methodsFor: 'private' stamp: 'cwp 10/26/2009 13:30'! canonicalizeElements: aCollection | result | result := OrderedCollection new. aCollection do: [:element | self addElement: element to: result]. ^ result! ! !FSPath class methodsFor: 'encodings' stamp: 'StephaneDucasse 2/18/2011 22:31'! extensionDelimiter "Return the extension delimiter character." ^ $.! ! !FSPath class methodsFor: 'instance creation' stamp: 'cwp 3/25/2011 21:01'! parent "Answer a path that resolves to the parent of the current working directory. This is similar to .. in unix, but doesn't rely on actual hardlinks being present in the filesystem." ^ FSRelativePath with: '..'! ! !FSPath class methodsFor: 'instance creation' stamp: 'cwp 11/15/2009 00:11'! parents: anInteger | path | path := self new: anInteger. 1 to: anInteger do: [:i | path at: i put: '..']. ^ path! ! !FSPath class methodsFor: 'instance creation' stamp: 'cwp 3/25/2011 21:04'! readFrom: aStream delimiter: aCharacter "Answer a path composed of several elements delimited by aCharacter" | elements out ch | elements := OrderedCollection new. out := (String new: 10) writeStream. [ aStream atEnd ] whileFalse: [ ch := aStream next. ch = aCharacter ifFalse: [ out nextPut: ch ] ifTrue: [ elements add: out contents. out := (String new: 10) writeStream ] ]. elements add: out contents. ^ self withAll: (self canonicalizeElements: elements)! ! !FSPath class methodsFor: 'instance creation' stamp: 'cwp 3/25/2011 21:04'! root "Answer the root path - ie, / on unix" ^ FSAbsolutePath new! ! !FSPath class methodsFor: 'private' stamp: 'cwp 3/25/2011 21:45'! with: aString "Answer a relative path of the given string. N.B. that the argument is not parsed; it is the name of a single path element, and path separators in it do not have special meaning." "(FSPath with: '/parent/child/') isRelative answers true because this is a relative path to a file or directory named '/parent/child/'. In bash: \/parent\/child\/" | inst | inst := self new: 1. inst at: 1 put: aString. ^ inst! ! !FSPath class methodsFor: 'private' stamp: 'cwp 12/13/2008 13:33'! withAll: aCollection | inst | inst := self new: aCollection size. aCollection withIndexDo: [:segment :index | inst at: index put: segment]. ^ inst! ! !FSPath class methodsFor: 'instance creation' stamp: 'cwp 3/25/2011 20:57'! workingDirectory "Answer a path that will always resolve to the current working directory." ^ FSRelativePath new! ! !FSPath methodsFor: 'navigating' stamp: 'cwp 11/17/2009 23:52'! , extension ^ self withName: self basename extension: extension! ! !FSPath methodsFor: 'navigating' stamp: 'cwp 12/13/2008 21:11'! / aString | path | path := self class new: self size + 1. path copyFrom: self. path at: path size put: aString. ^ path! ! !FSPath methodsFor: 'comparing' stamp: 'cwp 12/14/2008 17:36'! = other ^ self species = other species and: [self size = other size and: [(1 to: self size) allSatisfy: [:i | (self at: i) = (other at: i)]]]! ! !FSPath methodsFor: 'converting' stamp: 'cwp 10/10/2009 18:04'! asPathWith: anObject ^ self! ! !FSPath methodsFor: 'converting' stamp: 'cwp 2/19/2011 15:09'! asReference ^ FSFilesystem onDisk referenceTo: self! ! !FSPath methodsFor: 'navigating' stamp: 'cwp 9/22/2009 09:08'! asResolvedBy: anObject ^ anObject resolvePath: self! ! !FSPath methodsFor: 'accessing' stamp: 'StephaneDucasse 2/15/2010 18:06'! base "Returns the base of the basename, i.e. /foo/gloops.taz basename is 'gloops'" ^ self basename copyUpTo: self extensionDelimiter! ! !FSPath methodsFor: 'accessing' stamp: 'StephaneDucasse 2/15/2010 18:03'! basename "Returns the base of the basename, i.e. /foo/gloops.taz basename is 'gloops.taz'" ^ self at: self size! ! !FSPath methodsFor: 'comparing' stamp: 'cwp 10/26/2009 01:03'! contains: anObject ^ anObject isContainedBy: self! ! !FSPath methodsFor: 'comparing' stamp: 'cwp 10/25/2009 22:59'! containsPath: aPath self size < aPath size ifFalse: [^ false]. 1 to: self size do: [:i | (self at: i) = (aPath at: i) ifFalse: [^ false]]. ^ true! ! !FSPath methodsFor: 'comparing' stamp: 'cwp 10/25/2009 23:05'! containsReference: aReference ^ false! ! !FSPath methodsFor: 'private' stamp: 'cwp 12/13/2008 21:08'! copyFrom: aPath | size | size := aPath size min: self size. 1 to: size do: [:i | self at: i put: (aPath at: i)]. ! ! !FSPath methodsFor: 'accessing' stamp: 'cwp 10/11/2009 11:05'! delimiter ^ $/! ! !FSPath methodsFor: 'enumerating' stamp: 'cwp 7/18/2009 01:13'! do: aBlock 1 to: self size do: [ :index || segment | segment := self at: index. segment isEmpty ifFalse: [ aBlock value: segment ] ]! ! !FSPath methodsFor: 'accessing' stamp: 'StephaneDucasse 2/15/2010 18:04'! extension "Return the extension of path basename i.e., /foo/gloops.taz extension is 'taz'" ^ self basename copyAfter: self extensionDelimiter! ! !FSPath methodsFor: 'accessing' stamp: 'cwp 12/23/2008 11:25'! extensionDelimiter ^ self class extensionDelimiter! ! !FSPath methodsFor: 'accessing' stamp: 'sd 2/11/2011 21:02'! fullName "Return the fullName of the receiver." ^ self printString! ! !FSPath methodsFor: 'comparing' stamp: 'cwp 12/14/2008 17:06'! hash | hash | hash := self class identityHash. 1 to: self size do: [:i | hash := String stringHash: (self at: i) initialHash: hash]. ^ hash! ! !FSPath methodsFor: 'testing' stamp: 'cwp 2/26/2011 10:58'! isAbsolute self subclassResponsibility ! ! !FSPath methodsFor: 'private' stamp: 'cwp 10/25/2009 19:53'! isAllParents 1 to: self size do: [:i | (self at: i) = '..' ifFalse: [^ false]]. ^ true! ! !FSPath methodsFor: 'comparing' stamp: 'cwp 11/16/2009 09:06'! isChildOf: anObject ^ self parent = anObject! ! !FSPath methodsFor: 'comparing' stamp: 'cwp 10/25/2009 23:01'! isContainedBy: anObject ^ anObject containsPath: self! ! !FSPath methodsFor: 'testing' stamp: 'DamienPollet 2/20/2011 04:00'! isEmpty ^ self size = 0! ! !FSPath methodsFor: 'testing' stamp: 'cwp 12/13/2008 21:00'! isRelative ^ self isAbsolute not! ! !FSPath methodsFor: 'testing' stamp: 'cwp 2/26/2011 11:03'! isRoot self subclassResponsibility ! ! !FSPath methodsFor: 'testing' stamp: 'cwp 7/18/2009 00:42'! isWorkingDirectory ^ self size = 0! ! !FSPath methodsFor: 'private' stamp: 'cwp 11/15/2009 00:19'! lengthOfStemWith: aPath | limit index | limit := self size min: aPath size. index := 1. [index <= limit and: [(self at: index) = (aPath at: index)]] whileTrue: [index := index + 1]. ^ index - 1! ! !FSPath methodsFor: 'navigating' stamp: 'cwp 11/15/2009 00:00'! makeRelative: anObject ^ anObject relativeToPath: self! ! !FSPath methodsFor: 'navigating' stamp: 'cwp 10/25/2009 19:53'! parent | size parent | self isRoot ifTrue: [^ self]. self isAllParents ifTrue: [^ self / '..']. size := self size - 1. parent := self class new: size. 1 to: size do: [:i | parent at: i put: (self at: i)]. ^ parent! ! !FSPath methodsFor: 'printing' stamp: 'cwp 11/17/2009 10:22'! printOn: aStream self printOn: aStream delimiter: self delimiter. ! ! !FSPath methodsFor: 'printing' stamp: 'cwp 2/26/2011 17:58'! printOn: aStream delimiter: aCharacter (1 to: self size) do: [:index | aStream nextPutAll: (self at: index)] separatedBy: [aStream nextPut: aCharacter]! ! !FSPath methodsFor: 'printing' stamp: 'cwp 1/13/2009 21:27'! printWithDelimiter: aCharacter ^ String streamContents: [:out | self printOn: out delimiter: aCharacter]! ! !FSPath methodsFor: 'navigating' stamp: 'cwp 11/15/2009 00:00'! relativeTo: anObject ^ anObject makeRelative: self! ! !FSPath methodsFor: 'navigating' stamp: 'cwp 3/29/2011 16:23'! relativeToPath: aPath "Return the receiver as relative to the argument aPath" "(FSPath / 'griffle' / 'plonk' / 'nurp') relativeToPath: (FSPath / 'griffle') returns plonk/nurp" | prefix relative | aPath isRelative ifTrue: [^ aPath]. prefix := self lengthOfStemWith: aPath. relative := FSRelativePath parents: (aPath size - prefix). prefix + 1 to: self size do: [:i | relative := relative / (self at: i)]. ^ relative! ! !FSPath methodsFor: 'navigating' stamp: 'cwp 3/29/2011 16:23'! relativeToReference: aReference ^ self relativeToPath: aReference path! ! !FSPath methodsFor: 'navigating' stamp: 'cwp 11/16/2009 10:19'! resolve ^ self! ! !FSPath methodsFor: 'navigating' stamp: 'cwp 3/29/2011 16:25'! resolve: anObject "Return a path in which the argument has been interpreted in the context of the receiver. Different argument types have different resolution semantics, so we use double dispatch to resolve them correctly." ^ anObject asResolvedBy: self! ! !FSPath methodsFor: 'navigating' stamp: 'cwp 3/29/2011 16:29'! resolvePath: aPath "Answers an abolute path created by resolving the argument against the receiver. If the argument is abolute answer the argument itself. Otherwise, concatenate the two paths, then process all parent references '..', and create a path with the remaining elements." | elements | aPath isAbsolute ifTrue: [^ aPath]. elements := Array new: self size + aPath size. 1 to: self size do: [:i | elements at: i put: (self at: i)]. 1 to: aPath size do: [:i | elements at: self size + i put: (aPath at: i)]. ^ self class withAll: (self class canonicalizeElements: elements)! ! !FSPath methodsFor: 'navigating' stamp: 'cwp 9/22/2009 09:06'! resolveReference: aReference ^ aReference! ! !FSPath methodsFor: 'navigating' stamp: 'cwp 3/29/2011 16:30'! resolveString: aString "Treat strings as relative paths with a single element." ^ self / aString! ! !FSPath methodsFor: 'navigating' stamp: 'cwp 11/17/2009 23:51'! withExtension: extension | basename name | basename := self basename. ^ (basename endsWith: extension) ifTrue: [ self ] ifFalse: [name := basename copyUpToLast: self extensionDelimiter. self withName: name extension: extension]! ! !FSPath methodsFor: 'private' stamp: 'cwp 11/17/2009 23:58'! withName: name extension: extension | basename | basename :=String streamContents: [:out | out nextPutAll: name. out nextPut: self extensionDelimiter. out nextPutAll: extension]. ^ self copy at: self size put: basename; yourself! ! !FSPath methodsFor: 'enumerating' stamp: 'cwp 3/29/2011 16:42'! withParents | paths | paths := OrderedCollection new. 1 to: self size -1 do: [ :index | paths add: ((self class new: index) copyFrom: self) ]. paths add: self. ^ paths! ! FSPath variableSubclass: #FSRelativePath instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Filesystem-Core'! !FSRelativePath methodsFor: 'testing' stamp: 'cwp 2/26/2011 10:58'! isAbsolute ^ false! ! !FSRelativePath methodsFor: 'testing' stamp: 'cwp 2/26/2011 11:03'! isRoot ^ false! ! !FSRelativePath methodsFor: 'printing' stamp: 'cwp 2/27/2011 09:39'! printOn: aStream aStream nextPutAll: 'FSPath '. self isWorkingDirectory ifTrue: [aStream nextPutAll: 'workingDirectory'] ifFalse: [aStream nextPutAll: '* '''; nextPutAll: (self at: 1); nextPut: $'. 2 to: self size do: [:i | aStream nextPutAll: ' / '''; nextPutAll: (self at: i); nextPut: $']] ! ! !FSRelativePath methodsFor: 'printing' stamp: 'cwp 2/26/2011 18:00'! printOn: aStream delimiter: aCharacter self isWorkingDirectory ifTrue: [aStream nextPut: $.. ^ self]. super printOn: aStream delimiter: aCharacter! ! Object subclass: #FSPublisher instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Filesystem-Release'! !FSPublisher commentStamp: 'StephaneDucasse 2/3/2011 10:15' prior: 0! A dummy class to publish the code in FileSystem on SqueakSource and PharoTaskForces! !FSPublisher classSide methodsFor: 'as yet unclassified' stamp: 'StephaneDucasse 2/3/2011 10:20'! fetchFromColin "self fetchFromColin" Gofer new url: 'http://source.wiresong.ca/mc'; package: 'Filesystem'; fetch! ! !FSPublisher classSide methodsFor: 'as yet unclassified' stamp: 'StephaneDucasse 2/3/2011 10:27'! fetchFromLukas "self fetchFromLukas" Gofer new url: 'http://source.lukas-renggli.ch/fs'; package: 'Filesystem'; fetch! ! !FSPublisher classSide methodsFor: 'as yet unclassified' stamp: 'StephaneDucasse 2/3/2011 10:28'! fetchFromPharoTaskForces "self fetchFromPharoTaskForces" Gofer new squeaksource: 'PharoTaskForces'; package: 'Filesystem'; fetch! ! !FSPublisher classSide methodsFor: 'as yet unclassified' stamp: 'StephaneDucasse 2/3/2011 10:18'! fetchFromSqueaksource "self pushSqueakSource" Gofer new squeaksource: 'fs'; package: 'Filesystem'; fetch! ! !FSPublisher classSide methodsFor: 'as yet unclassified' stamp: 'StephaneDucasse 2/3/2011 10:17'! pushPharoTaskForces "self pushPharoTaskForces" Gofer new squeaksource: 'PharoTaskForces'; package: 'Filesystem'; push! ! !FSPublisher classSide methodsFor: 'as yet unclassified' stamp: 'StephaneDucasse 2/3/2011 10:16'! pushSqueakSource "self pushSqueakSource" Gofer new squeaksource: 'fs'; package: 'Filesystem'; push! ! Object subclass: #FSReference instanceVariableNames: 'filesystem path' classVariableNames: '' poolDictionaries: '' category: 'Filesystem-Core'! !FSReference commentStamp: 'cwp 3/29/2011 16:51' prior: 0! I combine a filesystem and path, which is sufficient to refer to a concrete file or directory. I provide methods for navigating my filesystem, performing filesystem operations and opening and closing files. I am the primary mechanism for working with files and directories. | working | working := FSFilesystem onDisk workingDirectory. working files | disk | disk := FSFilesystem onDisk. disk root. "a reference to the root directory" disk working. "a reference to the working directory" ! !FSReference class methodsFor: 'cross platform' stamp: 'cwp 3/25/2011 22:01'! / aString "Answer a reference to the argument resolved against the root of the current disk filesystem." ^ FSFilesystem onDisk / aString! ! !FSReference class methodsFor: 'windows' stamp: 'cwp 2/27/2011 09:59'! A ^ self filesystem: (FSFilesystem onDisk) path: FSPath / 'A:' ! ! !FSReference class methodsFor: 'windows' stamp: 'cwp 2/27/2011 09:59'! B ^ self filesystem: (FSFilesystem onDisk) path: FSPath / 'B:' ! ! !FSReference class methodsFor: 'windows' stamp: 'cwp 2/27/2011 09:59'! C ^ self filesystem: (FSFilesystem onDisk) path: FSPath / 'C:' ! ! !FSReference class methodsFor: 'windows' stamp: 'cwp 2/27/2011 09:59'! D ^ self filesystem: (FSFilesystem onDisk) path: FSPath / 'D:' ! ! !FSReference class methodsFor: 'windows' stamp: 'cwp 2/27/2011 09:59'! E ^ self filesystem: (FSFilesystem onDisk) path: FSPath / 'E:' ! ! !FSReference class methodsFor: 'windows' stamp: 'cwp 2/27/2011 09:59'! F ^ self filesystem: (FSFilesystem onDisk) path: FSPath / 'F:' ! ! !FSReference class methodsFor: 'windows' stamp: 'cwp 2/27/2011 09:59'! G ^ self filesystem: (FSFilesystem onDisk) path: FSPath / 'G:' ! ! !FSReference class methodsFor: 'windows' stamp: 'cwp 2/27/2011 09:59'! H ^ self filesystem: (FSFilesystem onDisk) path: FSPath / 'H:' ! ! !FSReference class methodsFor: 'windows' stamp: 'cwp 2/27/2011 09:59'! I ^ self filesystem: (FSFilesystem onDisk) path: FSPath / 'I:' ! ! !FSReference class methodsFor: 'windows' stamp: 'cwp 2/27/2011 09:59'! J ^ self filesystem: (FSFilesystem onDisk) path: FSPath / 'J:' ! ! !FSReference class methodsFor: 'windows' stamp: 'cwp 2/27/2011 09:59'! K ^ self filesystem: (FSFilesystem onDisk) path: FSPath / 'K:' ! ! !FSReference class methodsFor: 'windows' stamp: 'cwp 2/27/2011 09:59'! L ^ self filesystem: (FSFilesystem onDisk) path: FSPath / 'L:' ! ! !FSReference class methodsFor: 'windows' stamp: 'cwp 2/27/2011 09:59'! M ^ self filesystem: (FSFilesystem onDisk) path: FSPath / 'M:' ! ! !FSReference class methodsFor: 'windows' stamp: 'cwp 2/27/2011 09:59'! N ^ self filesystem: (FSFilesystem onDisk) path: FSPath / 'N:' ! ! !FSReference class methodsFor: 'windows' stamp: 'cwp 2/27/2011 09:59'! O ^ self filesystem: (FSFilesystem onDisk) path: FSPath / 'O:' ! ! !FSReference class methodsFor: 'windows' stamp: 'cwp 2/27/2011 09:59'! P ^ self filesystem: (FSFilesystem onDisk) path: FSPath / 'P:' ! ! !FSReference class methodsFor: 'windows' stamp: 'cwp 2/27/2011 09:59'! Q ^ self filesystem: (FSFilesystem onDisk) path: FSPath / 'Q:' ! ! !FSReference class methodsFor: 'windows' stamp: 'cwp 2/27/2011 09:59'! R ^ self filesystem: (FSFilesystem onDisk) path: FSPath / 'R:' ! ! !FSReference class methodsFor: 'windows' stamp: 'cwp 2/27/2011 09:59'! S ^ self filesystem: (FSFilesystem onDisk) path: FSPath / 'S:' ! ! !FSReference class methodsFor: 'windows' stamp: 'cwp 2/27/2011 09:59'! T ^ self filesystem: (FSFilesystem onDisk) path: FSPath / 'T:' ! ! !FSReference class methodsFor: 'windows' stamp: 'cwp 2/27/2011 09:59'! U ^ self filesystem: (FSFilesystem onDisk) path: FSPath / 'U:' ! ! !FSReference class methodsFor: 'windows' stamp: 'cwp 2/27/2011 09:59'! V ^ self filesystem: (FSFilesystem onDisk) path: FSPath / 'V:' ! ! !FSReference class methodsFor: 'windows' stamp: 'cwp 2/27/2011 09:59'! W ^ self filesystem: (FSFilesystem onDisk) path: FSPath / 'W:' ! ! !FSReference class methodsFor: 'windows' stamp: 'cwp 2/27/2011 09:59'! X ^ self filesystem: (FSFilesystem onDisk) path: FSPath / 'X:' ! ! !FSReference class methodsFor: 'windows' stamp: 'cwp 2/27/2011 09:59'! Y ^ self filesystem: (FSFilesystem onDisk) path: FSPath / 'Y:' ! ! !FSReference class methodsFor: 'windows' stamp: 'cwp 2/27/2011 09:59'! Z ^ self filesystem: (FSFilesystem onDisk) path: FSPath / 'Z:' ! ! !FSReference class methodsFor: 'instance creation' stamp: 'cwp 1/13/2009 21:11'! filesystem: aFilesystem path: aPath ^ self new setFilesystem: aFilesystem path: aPath! ! !FSReference methodsFor: 'navigating' stamp: 'cwp 7/20/2009 09:20'! , aString ^ self navigateWith: [path, aString]! ! !FSReference methodsFor: 'navigating' stamp: 'cwp 7/20/2009 09:36'! / anObject ^ self navigateWith: [path / anObject]! ! !FSReference methodsFor: 'comparing' stamp: 'MaxLeske 7/30/2010 17:28'! <= other ^ path asString <= other path asString! ! !FSReference methodsFor: 'comparing' stamp: 'cwp 7/20/2009 09:22'! = other ^ self species = other species and: [self path = other path and: [self filesystem = other filesystem]]! ! !FSReference methodsFor: 'enumerating' stamp: 'sd 2/11/2011 19:26'! allChildren "Return all the files and folders recursively nested in the receiver" ^ FSCollectVisitor breadthFirst: self collect: [:ea | ea reference]! ! !FSReference methodsFor: 'enumerating' stamp: 'sd 2/11/2011 19:27'! allDirectories "Return all the directories recursively nested in the receiver." ^ self allChildren reject: [:each | each isFile]! ! !FSReference methodsFor: 'enumerating' stamp: 'cwp 11/16/2009 10:40'! allEntries ^ FSCollectVisitor breadthFirst: self! ! !FSReference methodsFor: 'enumerating' stamp: 'sd 2/11/2011 19:27'! allFiles "Return all the files (not directories) recursively nested in the receiver." ^ self allChildren select: [:each | each isFile]! ! !FSReference methodsFor: 'converting' stamp: 'StephaneDucasse 2/3/2011 08:10'! asAbsolute "Return the receiver as an absolute file reference." ^ self isAbsolute ifTrue: [self] ifFalse: [filesystem referenceTo: (filesystem resolve: path)]! ! !FSReference methodsFor: 'converting' stamp: 'cwp 10/10/2009 18:04'! asPathWith: anObject ^ path! ! !FSReference methodsFor: 'converting' stamp: 'cwp 7/20/2009 09:08'! asReference ^ self! ! !FSReference methodsFor: 'resolving' stamp: 'cwp 9/22/2009 09:03'! asResolvedBy: anObject ^ anObject resolveReference: self! ! !FSReference methodsFor: 'accessing' stamp: 'StephaneDucasse 2/15/2010 17:57'! base "Returns the base of the basename, i.e. /foo/gloops.taz base is 'gloops'" ^ path base! ! !FSReference methodsFor: 'accessing' stamp: 'StephaneDucasse 2/2/2011 22:48'! basename "Returns the basename, i.e. /foo/gloops.taz basename is 'gloops.taz'" ^ path basename! ! !FSReference methodsFor: 'deprecated' stamp: 'cwp 3/29/2011 16:52'! childDirectories "Return all the directories (as opposed to files) contained in the receiver" self deprecated: 'Use directories'. ^ self directories ! ! !FSReference methodsFor: 'deprecated' stamp: 'sd 2/11/2011 19:53'! childFiles "Return the direct children (files and folders) of the receiver." self deprecated: 'Use files instead'. ^ self files ! ! !FSReference methodsFor: 'navigating' stamp: 'cwp 3/25/2011 22:05'! children "Answer an array containing references to the direct children of this reference." ^ (filesystem childrenAt: path) collect: [:ea | FSReference filesystem: filesystem path: ea]! ! !FSReference methodsFor: 'comparing' stamp: 'cwp 10/26/2009 01:03'! contains: anObject ^ anObject isContainedBy: self! ! !FSReference methodsFor: 'comparing' stamp: 'cwp 10/26/2009 00:54'! containsPath: aPath ^ self path containsPath: aPath! ! !FSReference methodsFor: 'comparing' stamp: 'cwp 10/25/2009 23:02'! containsReference: aReference ^ aReference filesystem = filesystem and: [path contains: aReference path]! ! !FSReference methodsFor: 'operations' stamp: 'cwp 3/29/2011 16:53'! copyAllTo: aResolvable FSCopyVisitor copy: self asAbsolute to: aResolvable resolve! ! !FSReference methodsFor: 'operations' stamp: 'cwp 2/18/2011 14:06'! copyTo: aReference self isDirectory ifTrue: [ aReference ensureDirectory ] ifFalse: [ filesystem = aReference filesystem ifTrue: [ filesystem copy: path to: aReference path ] ifFalse: [ filesystem copy: path toReference: aReference ] ]! ! !FSReference methodsFor: 'operations' stamp: 'cwp 11/17/2009 21:05'! createDirectory filesystem createDirectory: path! ! !FSReference methodsFor: 'operations' stamp: 'cwp 7/22/2009 07:42'! delete filesystem delete: path! ! !FSReference methodsFor: 'operations' stamp: 'cwp 11/15/2009 00:51'! deleteAll FSDeleteVisitor delete: self! ! !FSReference methodsFor: 'navigating' stamp: 'sd 2/11/2011 19:32'! directories "Return all the directories (by opposition to files) contained in the receiver" ^ self children reject: [:each | each isFile]! ! !FSReference methodsFor: 'operations' stamp: 'sd 2/11/2011 20:16'! ensureDirectory "Create if necessary a directory for the receiver." filesystem ensureDirectory: path ! ! !FSReference methodsFor: 'navigating' stamp: 'sd 2/11/2011 20:14'! entries "Return the entries (meta data - file description) of the direct children of the receiver" ^ filesystem entriesAt: path ! ! !FSReference methodsFor: 'accessing' stamp: 'sd 2/11/2011 19:58'! entry "Return the entry (meta data) describing the receiver." ^ filesystem entryAt: path! ! !FSReference methodsFor: 'testing' stamp: 'cwp 1/13/2009 20:52'! exists ^ filesystem exists: path! ! !FSReference methodsFor: 'accessing' stamp: 'cwp 3/29/2011 16:56'! extension "Returns the extension of the basename, i.e. /foo/gloops.taz extension is 'taz'. Note that compound extensions are returned completely: /foo/gloops.taz.txt extension is 'taz.txt'" ^ path extension! ! !FSReference methodsFor: 'streams' stamp: 'lr 7/19/2010 19:31'! fileStreamDo: aBlock | stream | stream := filesystem openFileStream: path writable: true. ^ [ aBlock value: stream ] ensure: [ stream flush; close ] ! ! !FSReference methodsFor: 'navigating' stamp: 'cwp 3/29/2011 16:56'! files "Return all the files (as opposed to folders) contained in the receiver" ^self children select: [:each | each isFile]! ! !FSReference methodsFor: 'accessing' stamp: 'sd 2/11/2011 19:58'! filesystem "Return the filesystem to which the receiver belong." ^ filesystem! ! !FSReference methodsFor: 'accessing' stamp: 'sd 2/11/2011 20:34'! fullName "Return the full path name of the receiver." ^ filesystem stringFromPath: (filesystem resolve: path)! ! !FSReference methodsFor: 'comparing' stamp: 'cwp 9/16/2009 23:54'! hash ^ path hash bitXor: filesystem hash! ! !FSReference methodsFor: 'testing' stamp: 'lr 7/13/2010 15:36'! ifFile: fBlock ifDirectory: dBlock ifAbsent: aBlock ^ self isFile ifTrue: [ fBlock value ] ifFalse: [ self isDirectory ifTrue: [ dBlock value ] ifFalse: [ aBlock value ] ]! ! !FSReference methodsFor: 'testing' stamp: 'cwp 7/20/2009 09:24'! isAbsolute ^ path isAbsolute! ! !FSReference methodsFor: 'testing' stamp: 'cwp 11/16/2009 09:06'! isChildOf: anObject ^ self parent = anObject! ! !FSReference methodsFor: 'comparing' stamp: 'cwp 10/25/2009 23:03'! isContainedBy: anObject ^ anObject containsReference: self! ! !FSReference methodsFor: 'testing' stamp: 'cwp 1/13/2009 21:39'! isDirectory ^ filesystem isDirectory: path! ! !FSReference methodsFor: 'testing' stamp: 'cwp 1/13/2009 21:57'! isFile ^ filesystem isFile: path! ! !FSReference methodsFor: 'testing' stamp: 'cwp 7/20/2009 09:25'! isRelative ^ path isRelative! ! !FSReference methodsFor: 'testing' stamp: 'cwp 7/20/2009 09:26'! isRoot ^ path isRoot! ! !FSReference methodsFor: 'navigating' stamp: 'cwp 11/15/2009 00:26'! makeRelative: anObject ^ anObject relativeToReference: self! ! !FSReference methodsFor: 'navigating' stamp: 'cwp 7/20/2009 09:19'! navigateWith: aBlock | newPath | newPath := aBlock value. ^ path == newPath ifTrue: [self] ifFalse: [filesystem referenceTo: newPath]! ! !FSReference methodsFor: 'private' stamp: 'cwp 7/22/2009 22:05'! openWritable: aBoolean ^ filesystem open: path writable: aBoolean! ! !FSReference methodsFor: 'navigating' stamp: 'cwp 7/20/2009 09:28'! parent ^ self navigateWith: [path parent]! ! !FSReference methodsFor: 'accessing private' stamp: 'sd 2/11/2011 20:00'! path "Return the path internal representation that denotes the receiver in the context of its filesystem. " ^ path! ! !FSReference methodsFor: 'printing' stamp: 'sd 2/11/2011 20:34'! pathString "Return the full path name of the receiver." ^ filesystem stringFromPath: (filesystem resolve: path)! ! !FSReference methodsFor: 'printing' stamp: 'cwp 10/11/2009 22:32'! printOn: aStream filesystem forReferencePrintOn: aStream. filesystem printPath: path on: aStream! ! !FSReference methodsFor: 'streams' stamp: 'cwp 9/22/2009 09:55'! readStream ^ filesystem readStreamOn: path! ! !FSReference methodsFor: 'streams' stamp: 'lr 7/19/2010 19:32'! readStreamDo: aBlock | stream | stream := self readStream. ^ [ aBlock value: stream ] ensure: [ stream close ]! ! !FSReference methodsFor: 'streams' stamp: 'lr 7/19/2010 19:35'! readStreamDo: doBlock ifAbsent: absentBlock ^ self isFile ifTrue: [ self readStreamDo: doBlock ] ifFalse: [ absentBlock value ]! ! !FSReference methodsFor: 'streams' stamp: 'lr 7/19/2010 19:35'! readStreamIfAbsent: absentBlock ^ self isFile ifTrue: [ self readStream ] ifFalse: [ absentBlock value ]! ! !FSReference methodsFor: 'navigating' stamp: 'cwp 3/29/2011 16:59'! relativeTo: landmark "Answer a new path relative to landmark." "parent/child/grandChild relativeTo: parent returns child/grandChild (FSFilesystem onDisk / 'griffle' / 'plonk' / 'nurp') relativeTo: (FSFilesystem onDisk / 'griffle') returns plonk/nurp" ^ landmark makeRelative: self! ! !FSReference methodsFor: 'as yet unclassified' stamp: 'DamienPollet 3/1/2011 19:05'! relativeToPath: landmarkPath ^ path relativeTo: landmarkPath! ! !FSReference methodsFor: 'navigating' stamp: 'DamienPollet 3/1/2011 19:05'! relativeToReference: landmarkReference "Return the path of the receiver relative to landmarkReference." ^ path relativeTo: landmarkReference path! ! !FSReference methodsFor: 'operations' stamp: 'sd 2/11/2011 21:45'! renameAs: aStringOrPath | res | res := self filesystem rename: self as: aStringOrPath. res ifNotNil: [self setFilesystem: filesystem path: (self filesystem resolvePath: aStringOrPath) ]. ^ self ! ! !FSReference methodsFor: 'resolving' stamp: 'cwp 10/26/2009 02:02'! resolve ^ self! ! !FSReference methodsFor: 'resolving' stamp: 'cwp 10/26/2009 01:03'! resolve: anObject ^ anObject asResolvedBy: self! ! !FSReference methodsFor: 'resolving' stamp: 'cwp 9/22/2009 09:03'! resolvePath: anObject ^ self navigateWith: [path resolve: anObject]! ! !FSReference methodsFor: 'resolving' stamp: 'cwp 9/22/2009 09:23'! resolveReference: aReference ^ (filesystem = aReference filesystem or: [aReference isRelative]) ifTrue: [filesystem referenceTo: (path resolvePath: aReference path)] ifFalse: [aReference]! ! !FSReference methodsFor: 'resolving' stamp: 'cwp 11/21/2009 11:30'! resolveString: aString | thePath | thePath := filesystem pathFromString: aString. ^ filesystem referenceTo: (path resolve: thePath)! ! !FSReference methodsFor: 'initialize-release' stamp: 'cwp 1/13/2009 21:12'! setFilesystem: aFilesystem path: aPath filesystem := aFilesystem. path := aPath! ! !FSReference methodsFor: 'navigating' stamp: 'cwp 11/17/2009 23:24'! withExtension: aString ^ self navigateWith: [ path withExtension: aString ]! ! !FSReference methodsFor: 'streams' stamp: 'cwp 7/28/2009 23:01'! writeStream ^ filesystem writeStreamOn: path! ! !FSReference methodsFor: 'streams' stamp: 'lr 7/19/2010 19:34'! writeStreamDo: aBlock | stream | stream := self writeStream. ^ [ aBlock value: stream ] ensure: [ stream close ]! ! !FSReference methodsFor: 'streams' stamp: 'lr 7/19/2010 19:33'! writeStreamDo: doBlock ifPresent: presentBlock ^ self isFile ifTrue: [ presentBlock value ] ifFalse: [ self writeStreamDo: doBlock ]! ! !FSReference methodsFor: 'streams' stamp: 'lr 7/19/2010 19:35'! writeStreamIfPresent: presentBlock ^ self isFile ifTrue: [ presentBlock value ] ifFalse: [ self writeStream ]! ! Object subclass: #FSReleaseInfo instanceVariableNames: 'version' classVariableNames: 'Current' poolDictionaries: '' category: 'Filesystem-Release'! !FSReleaseInfo class methodsFor: 'accessing' stamp: 'cwp 11/20/2009 12:01'! current ^ Current! ! !FSReleaseInfo class methodsFor: 'accessing' stamp: 'cwp 11/20/2009 12:00'! currentVersion: anArray Current := self version: anArray! ! !FSReleaseInfo class methodsFor: 'accessing' stamp: 'cwp 11/20/2009 12:00'! version: anArray ^ self new initializeWithVersion: anArray! ! !FSReleaseInfo methodsFor: 'initialization' stamp: 'cwp 11/20/2009 12:00'! initializeWithVersion: anArray self initialize. version := anArray! ! !FSReleaseInfo methodsFor: 'accessing' stamp: 'cwp 11/20/2009 12:02'! version ^ version! ! Object subclass: #FSResolver instanceVariableNames: 'next' classVariableNames: '' poolDictionaries: '' category: 'Filesystem-Resolvers'! !FSResolver commentStamp: 'cwp 3/29/2011 17:04' prior: 0! I am an abstract superclass for objects that can resolve origins into references. Such objects use the Chain of Responsibility pattern, and when unable to resolve a particular origin, delegate that resolution request to the next resolver in the list. next The next resolver in the list, or nil ! FSResolver subclass: #FSInteractiveResolver instanceVariableNames: 'cache' classVariableNames: '' poolDictionaries: '' category: 'Filesystem-Resolvers'! !FSInteractiveResolver commentStamp: 'cwp 11/18/2009 11:56' prior: 0! I resolve origins by consulting the user. I maintain a cache of the user's responses.! !FSInteractiveResolver methodsFor: 'accessing' stamp: 'cwp 10/27/2009 10:29'! flushLocalCache cache := IdentityDictionary new! ! !FSInteractiveResolver methodsFor: 'initialize-release' stamp: 'cwp 10/27/2009 10:29'! initialize self flushLocalCache! ! !FSInteractiveResolver methodsFor: 'resolving' stamp: 'cwp 10/27/2009 10:12'! resolve: origin ^ cache at: origin ifAbsent: [self unknownOrigin: origin] ! ! !FSInteractiveResolver methodsFor: 'resolving' stamp: 'cwp 10/27/2009 11:15'! unknownOrigin: origin | reference | ^ (next ifNotNil: [next resolve: origin]) ifNil: [reference := FSResolutionRequest for: origin. reference ifNotNil: [cache at: origin put: reference]]! ! FSResolver subclass: #FSPlatformResolver instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Filesystem-Resolvers'! !FSPlatformResolver commentStamp: 'cwp 11/18/2009 11:56' prior: 0! I am an abstract superclass for platform-specific resolvers.! FSPlatformResolver subclass: #FSMacOSResolver instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Filesystem-Resolvers'! !FSMacOSResolver commentStamp: 'cwp 11/18/2009 11:57' prior: 0! I am an expert on Mac OS X filesystem conventions. I resolve origins according to these conventions.! !FSMacOSResolver class methodsFor: 'accessing' stamp: 'cwp 10/27/2009 10:59'! platformName ^ 'Mac OS'! ! !FSMacOSResolver methodsFor: 'origins' stamp: 'cwp 10/27/2009 21:45'! desktop ^ self home / 'Desktop'! ! !FSMacOSResolver methodsFor: 'origins' stamp: 'cwp 10/27/2009 21:50'! documents ^ self home / 'Documents'! ! !FSMacOSResolver methodsFor: 'origins' stamp: 'cwp 10/27/2009 21:39'! home ^ (self resolveString: SecurityManager default untrustedUserDirectory) parent parent parent parent parent! ! !FSPlatformResolver class methodsFor: 'instance creation' stamp: 'tg 11/8/2010 19:05'! forCurrentPlatform | platformName | platformName := Smalltalk os platformName. ^ (self allSubclasses detect: [:ea | ea platformName = platformName]) new! ! !FSPlatformResolver class methodsFor: 'accessing' stamp: 'cwp 10/27/2009 10:58'! platformName ^ nil! ! !FSPlatformResolver methodsFor: 'origins' stamp: 'lr 7/13/2010 15:35'! desktop ^ self subclassResponsibility! ! !FSPlatformResolver methodsFor: 'origins' stamp: 'lr 7/13/2010 15:35'! documents ^ self subclassResponsibility! ! !FSPlatformResolver methodsFor: 'origins' stamp: 'cwp 10/27/2009 21:01'! home ^ self subclassResponsibility! ! !FSPlatformResolver methodsFor: 'resolving' stamp: 'cwp 10/27/2009 21:45'! supportedOrigins ^ #(home desktop documents)! ! FSPlatformResolver subclass: #FSUnixResolver instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Filesystem-Resolvers'! !FSUnixResolver class methodsFor: 'accessing' stamp: 'pls 12/18/2009 04:53'! platformName ^ 'unix'! ! !FSUnixResolver methodsFor: 'origins' stamp: 'pls 12/18/2009 04:52'! desktop ^ self home / 'Desktop'! ! !FSUnixResolver methodsFor: 'origins' stamp: 'pls 12/18/2009 04:53'! documents ^ self home / 'Documents'! ! !FSUnixResolver methodsFor: 'origins' stamp: 'pls 12/18/2009 04:52'! home ^ (self resolveString: SecurityManager default untrustedUserDirectory) parent parent parent parent parent! ! FSPlatformResolver subclass: #FSWindowsResolver instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Filesystem-Resolvers'! !FSWindowsResolver commentStamp: 'cwp 11/18/2009 11:57' prior: 0! I am an expert on Windows filesystem conventions. I resolve origins according to these conventions.! !FSWindowsResolver class methodsFor: 'accessing' stamp: 'cwp 10/27/2009 10:59'! platformName ^ 'Win32'! ! !FSWindowsResolver methodsFor: 'origins' stamp: 'cwp 10/27/2009 21:45'! desktop ^ self home / 'Desktop'! ! !FSWindowsResolver methodsFor: 'origins' stamp: 'cwp 10/27/2009 21:50'! documents ^ self home / 'My Documents'! ! !FSWindowsResolver methodsFor: 'origins' stamp: 'cwp 11/20/2009 22:55'! home | pathString | pathString := SecurityManager default untrustedUserDirectory. ^ (self resolveString: pathString) parent parent! ! !FSResolver methodsFor: 'accessing' stamp: 'cwp 10/26/2009 20:53'! addResolver: aResolver next ifNil: [next := aResolver] ifNotNil: [next addResolver: aResolver]! ! !FSResolver methodsFor: 'resolving' stamp: 'cwp 10/27/2009 11:18'! canResolve: aSymbol ^ self supportedOrigins includes: aSymbol! ! !FSResolver methodsFor: 'accessing' stamp: 'cwp 10/27/2009 10:28'! flushCaches self flushLocalCache. next ifNotNil: [next flushCaches]! ! !FSResolver methodsFor: 'accessing' stamp: 'cwp 10/27/2009 10:28'! flushLocalCache! ! !FSResolver methodsFor: 'accessing' stamp: 'cwp 10/27/2009 11:25'! next ^ next! ! !FSResolver methodsFor: 'resolving' stamp: 'cwp 10/27/2009 11:18'! resolve: aSymbol ^ (self canResolve: aSymbol) ifTrue: [self perform: aSymbol] ifFalse: [self unknownOrigin: aSymbol]! ! !FSResolver methodsFor: 'resolving' stamp: 'cwp 2/27/2011 10:11'! resolveString: aString | decoded fs | decoded := (FilePath pathName: aString isEncoded: true) asSqueakPathName. fs := FSFilesystem onDisk. ^ FSReference filesystem: fs path: (fs pathFromString: decoded)! ! !FSResolver methodsFor: 'resolving' stamp: 'cwp 10/26/2009 20:06'! supportedOrigins ^ #()! ! !FSResolver methodsFor: 'resolving' stamp: 'cwp 10/27/2009 09:26'! unknownOrigin: aSymbol ^ next ifNotNil: [next resolve: aSymbol]! ! FSResolver subclass: #FSSystemResolver instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Filesystem-Resolvers'! !FSSystemResolver commentStamp: 'cwp 11/18/2009 11:58' prior: 0! I resolve origins that are related to the currently running Smalltalk system, using primitives provided by the VM. ! !FSSystemResolver methodsFor: 'origins' stamp: 'lr 7/13/2010 13:31'! changes ^ self image withExtension: 'changes'! ! !FSSystemResolver methodsFor: 'origins' stamp: 'cwp 10/26/2009 20:04'! image ^ self resolveString: self primImagePath! ! !FSSystemResolver methodsFor: 'origins' stamp: 'lr 7/13/2010 13:34'! imageDirectory ^ self image parent! ! !FSSystemResolver methodsFor: 'primitives' stamp: 'cwp 10/26/2009 20:05'! primImagePath "Answer the full path name for the current image." self primitiveFailed! ! !FSSystemResolver methodsFor: 'primitives' stamp: 'lr 7/13/2010 13:27'! primVmDirectoryPath "Answer the full path name for the current virtual machine." self primitiveFailed! ! !FSSystemResolver methodsFor: 'resolving' stamp: 'lr 7/13/2010 13:35'! supportedOrigins ^ #(image imageDirectory changes vmBinary vmDirectory)! ! !FSSystemResolver methodsFor: 'origins' stamp: 'cwp 10/26/2009 20:04'! vmBinary ^ self resolveString: (SmalltalkImage current getSystemAttribute: 0)! ! !FSSystemResolver methodsFor: 'origins' stamp: 'lr 7/13/2010 13:33'! vmDirectory ^ self resolveString: self primVmDirectoryPath! ! Object subclass: #FSStore instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Filesystem-Core'! FSStore subclass: #FSDiskStore instanceVariableNames: '' classVariableNames: 'Current Primitives' poolDictionaries: '' category: 'Filesystem-Disk'! !FSDiskStore classSide methodsFor: 'current' stamp: 'cwp 2/18/2011 17:22'! activeClass self allSubclassesDo: [:ea | ea isActiveClass ifTrue: [^ ea]]. ^ self! ! !FSDiskStore classSide methodsFor: 'current' stamp: 'cwp 2/27/2011 10:02'! createDefault ^ self new! ! !FSDiskStore classSide methodsFor: 'current' stamp: 'cwp 2/27/2011 10:08'! current ^ Current ifNil: [Current := self activeClass createDefault]! ! !FSDiskStore classSide methodsFor: 'class initialization' stamp: 'cwp 2/27/2011 10:17'! initialize self useFilePlugin. Smalltalk addToStartUpList: self. ! ! !FSDiskStore classSide methodsFor: 'current' stamp: 'cwp 2/18/2011 17:20'! isActiveClass ^ self delimiter = Primitives delimiter! ! !FSDiskStore classSide methodsFor: 'current' stamp: 'cwp 2/27/2011 10:19'! reset Current := nil! ! !FSDiskStore classSide methodsFor: 'class initialization' stamp: 'cwp 2/27/2011 10:19'! startUp: resuming resuming ifTrue: [self reset]! ! !FSDiskStore classSide methodsFor: 'class initialization' stamp: 'cwp 2/18/2011 11:33'! useFilePlugin Primitives := FSFilePluginPrims new! ! !FSDiskStore methodsFor: 'as yet unclassified' stamp: 'cwp 2/27/2011 09:50'! = other ^ self species = other species! ! !FSDiskStore methodsFor: 'public' stamp: 'cwp 2/18/2011 13:27'! basenameFromEntry: entry ^ entry at: 1! ! !FSDiskStore methodsFor: 'private' stamp: 'cwp 2/18/2011 11:32'! basicIsDirectory: anEntry ^ anEntry at: 4! ! !FSDiskStore methodsFor: 'private' stamp: 'cwp 2/18/2011 11:33'! basicIsFile: anEntry ^ (anEntry at: 4) not! ! !FSDiskStore methodsFor: 'public' stamp: 'cwp 2/28/2011 12:35'! basicOpen: aPath writable: aBoolean | string encoded | string := self stringFromPath: aPath. encoded := Primitives encode: string. ^ Primitives open: encoded writable: aBoolean! ! !FSDiskStore methodsFor: 'public' stamp: 'cwp 3/25/2011 13:10'! createDirectory: path "Create a directory for the argument path. If the path refers to an existing file, raise FileExists. If the path refers to an existing directory, raise DirectoryExists. If the parent directory of the path does not exist, raise DirectoryDoesNotExist" | parent encodedPathString pathString result | pathString := self stringFromPath: path. encodedPathString := Primitives encode: pathString. result := Primitives createDirectory: encodedPathString. result ifNil: [ parent := path parent. (self exists: path) ifTrue: [ (self isFile: path) ifTrue: [ self fileExists: path ] ifFalse: [ self directoryExists: path ] ]. (self isDirectory: parent) ifFalse: [ ^ self directoryDoesNotExist: parent ]. self primitiveFailed ]. ^ self! ! !FSDiskStore methodsFor: 'as yet unclassified' stamp: 'cwp 2/27/2011 10:03'! defaultWorkingDirectory | pathString | pathString := Primitives decode: Primitives imageFile. ^ (self pathFromString: pathString) parent! ! !FSDiskStore methodsFor: 'public' stamp: 'cwp 2/27/2011 10:03'! delete: path | pathString encodedPathString | pathString := self stringFromPath: path. encodedPathString := Primitives encode: pathString. (self isDirectory: path) ifTrue: [ Primitives deleteDirectory: encodedPathString ] ifFalse: [ StandardFileStream retryWithGC: [ Primitives deleteFile: encodedPathString ] until: [ :result | result notNil ] forFileNamed: pathString ]! ! !FSDiskStore methodsFor: 'private' stamp: 'cwp 2/27/2011 10:03'! directoryAt: aPath ifAbsent: absentBlock nodesDo: aBlock | encodedPathString index entry pathString | index := 1. pathString := self stringFromPath: aPath. encodedPathString := Primitives encode: pathString. entry := Primitives lookupEntryIn: encodedPathString index: index. entry = #badDirectoryPath ifTrue: [ ^ absentBlock value ]. [ entry isNil ] whileFalse: [ entry at: 1 put: (Primitives decode: entry first). aBlock value: entry. index := index + 1. entry := Primitives lookupEntryIn: encodedPathString index: index ]. ^ self! ! !FSDiskStore methodsFor: 'private' stamp: 'cwp 2/18/2011 14:45'! entryFromNode: anArray filesystem: aFilesystem path: aPath ^ FSDirectoryEntry filesystem: aFilesystem path: aPath creation: (anArray at: 2) modification: (anArray at: 3) isDir: (anArray at: 4) size: (anArray at: 5)! ! !FSDiskStore methodsFor: 'public' stamp: 'cwp 2/18/2011 14:56'! entryFromNode: node path: path for: aFileystem | entryPath | entryPath := path / (self basenameFromEntry: node). ^ self entryFromNode: node filesystem: aFileystem path: entryPath! ! !FSDiskStore methodsFor: 'as yet unclassified' stamp: 'cwp 2/27/2011 08:32'! forReferencePrintOn: aStream ! ! !FSDiskStore methodsFor: 'as yet unclassified' stamp: 'cwp 2/18/2011 16:02'! handleClass ^ FSFileHandle! ! !FSDiskStore methodsFor: 'as yet unclassified' stamp: 'cwp 2/27/2011 09:51'! hash ^ self species hash! ! !FSDiskStore methodsFor: 'private' stamp: 'cwp 3/25/2011 13:18'! nodeAt: aPath ifPresent: presentBlock ifAbsent: absentBlock | name | aPath isRoot ifTrue: [ ^ presentBlock value: self rootNode ]. name := aPath basename. self directoryAt: aPath parent ifAbsent: absentBlock nodesDo: [ :entry | (self filename: (entry at: 1) matches: name) ifTrue: [ ^ presentBlock value: entry ] ]. ^ absentBlock value! ! !FSDiskStore methodsFor: 'public' stamp: 'cwp 2/18/2011 13:36'! openFileStream: path writable: aBoolean | fullPath | fullPath := self stringFromPath: path. ^ StandardFileStream new open: fullPath forWrite: aBoolean! ! !FSDiskStore methodsFor: 'private' stamp: 'cwp 2/18/2011 11:37'! rootNode ^ #('' 0 0 true 0)! ! FSDiskStore subclass: #FSUnixStore instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Filesystem-Disk'! !FSUnixStore classSide methodsFor: 'public' stamp: 'cwp 2/18/2011 17:19'! delimiter ^ $/! ! FSDiskStore subclass: #FSWindowsStore instanceVariableNames: 'disk' classVariableNames: 'Disks' poolDictionaries: '' category: 'Filesystem-Disk'! !FSWindowsStore classSide methodsFor: 'accessing' stamp: 'cwp 2/18/2011 17:19'! delimiter ^ $\! ! !FSWindowsStore methodsFor: 'converting' stamp: 'cwp 2/27/2011 08:15'! pathFromString: aString | class | class := ((aString at: 1) isLetter and: [(aString at: 2) = $:]) ifTrue: [FSAbsolutePath] ifFalse: [FSRelativePath]. ^ class readFrom: aString readStream delimiter: self delimiter! ! !FSWindowsStore methodsFor: 'as yet unclassified' stamp: 'cwp 2/28/2011 12:32'! printPath: aPath on: aStream aPath printOn: aStream delimiter: self delimiter! ! FSStore subclass: #FSMemoryStore instanceVariableNames: 'root' classVariableNames: '' poolDictionaries: '' category: 'Filesystem-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 2/19/2011 00:52'! 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 directoryDoesNotExist: destination parent ]. (dict includesKey: destination basename) ifTrue: [ pBlock value ]. dict at: destination basename put: bytes copy ] ifAbsent: [ self directoryDoesNotExist: 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 2/18/2011 16:22'! basicOpen: path writable: aBoolean ^ self nodeAt: path ifPresent: [ :bytes | bytes ] ifAbsent: [ aBoolean ifFalse: [ self fileDoesNotExist: path ] ifTrue: [ self createFile: path ] ]! ! !FSMemoryStore methodsFor: 'public' stamp: 'cwp 2/18/2011 14:40'! createDirectory: path | parent | parent := path parent. ^ self nodeAt: parent ifPresent: [ :dict | dict at: path basename ifPresent: [ :node | node isDictionary ifTrue: [ self directoryExists: path ] ifFalse: [ self fileExists: path ] ]. dict at: path basename put: Dictionary new ] ifAbsent: [ self directoryDoesNotExist: parent ]! ! !FSMemoryStore methodsFor: 'private' stamp: 'cwp 2/18/2011 16:11'! createFile: aPath ^ self nodeAt: aPath parent ifPresent: [ :dict | (self basicIsDirectory: dict) ifTrue: [ dict at: aPath basename put: ByteArray new ] ] ifAbsent: [ self directoryDoesNotExist: 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 2/19/2011 00:53'! replaceFile: path in: aBlock ^ self nodeAt: path parent ifPresent: [ :dict | | old new | (self basicIsDirectory: dict) ifFalse: [ self fileDoesNotExist: path ]. old := dict at: path basename ifAbsent: [ self fileDoesNotExist: path ]. new := aBlock value: old. dict at: path basename put: new ] ifAbsent: [ self fileDoesNotExist: path ]! ! !FSMemoryStore methodsFor: 'as yet unclassified' stamp: 'cwp 2/18/2011 12:46'! root ^ root! ! FSMemoryStore subclass: #FSZipStore instanceVariableNames: 'reference' classVariableNames: '' poolDictionaries: '' category: 'Filesystem-Zip'! !FSZipStore classSide methodsFor: 'as yet unclassified' stamp: 'cwp 2/18/2011 23:46'! reference: aReference ^ self basicNew initializeWithReference: aReference yourself! ! !FSZipStore methodsFor: 'public' stamp: 'cwp 2/19/2011 14:42'! close | archive fs stream | archive := ZipArchive new. fs := FSFilesystem store: self. fs root allChildren do: [ :each | each isFile ifTrue: [ each readStreamDo: [ :output | archive addString: output contents as: each path printString ] ] ]. archive writeTo: (stream := WriteStream on: ByteArray new); close. self reference writeStreamDo: [ :output | output nextPutAll: stream contents ]! ! !FSZipStore methodsFor: 'as yet unclassified' stamp: 'cwp 2/18/2011 23:49'! initializeWithReference: aReference self initialize. reference := aReference! ! !FSZipStore methodsFor: 'public' stamp: 'cwp 2/19/2011 01:41'! open | archive output | self reference exists ifFalse: [ ^ self ]. archive := ZipArchive new. self reference readStreamDo: [ :input | archive readFrom: input contents readStream. archive members do: [ :member | | path | path := self pathFromMember: member. member isDirectory ifTrue: [ self ensureDirectory: path ] ifFalse: [ self ensureDirectory: path parent. self createFile: path. self replaceFile: path in: [ :bytes | output := bytes writeStream. member rewindData. member copyRawDataTo: output. output contents ] ] ] ]. ^ self! ! !FSZipStore methodsFor: 'private' stamp: 'cwp 2/19/2011 01:37'! pathFromMember: anArchiveMember | path | path := FSPath root resolve: anArchiveMember fileName. ^ path basename isEmpty ifTrue: [ path parent ] ifFalse: [ path ]! ! !FSZipStore methodsFor: 'as yet unclassified' stamp: 'cwp 2/18/2011 23:49'! reference ^ reference! ! !FSStore methodsFor: 'private' stamp: 'cwp 2/19/2011 00:49'! basicCopy: source ifAbsent: aBlock to: destination ifPresent: pBlock filesystem: aFilesystem | buffer out in | in := nil. out := nil. buffer := nil. [ in := aFilesystem readStreamOn: source. in ifNil: [ aBlock value ]. (self exists: destination) ifTrue: [ pBlock value ]. out := aFilesystem writeStreamOn: destination. buffer := ByteArray new: 1024. [ in atEnd ] whileFalse: [ buffer := in nextInto: buffer. out nextPutAll: buffer ] ] ensure: [ in ifNotNil: [ in close ]. out ifNotNil: [ out close ] ]! ! !FSStore methodsFor: 'abstract' stamp: 'cwp 2/18/2011 13:15'! basicIsDirectory: aPath self subclassResponsibility ! ! !FSStore methodsFor: 'abstract' stamp: 'cwp 2/18/2011 14:32'! basicIsFile: entry self subclassResponsibility ! ! !FSStore methodsFor: 'abstract' stamp: 'cwp 2/19/2011 01:39'! close "Some kinds of filesystems need to open connections to external resources"! ! !FSStore methodsFor: 'abstract' stamp: 'cwp 2/18/2011 23:59'! createDirectory: aPath self subclassResponsibility ! ! !FSStore methodsFor: 'as yet unclassified' stamp: 'cwp 2/18/2011 16:49'! defaultWorkingDirectory ^ FSPath root! ! !FSStore methodsFor: 'abstract' stamp: 'cwp 2/18/2011 13:25'! delete: aPath self subclassResponsibility ! ! !FSStore methodsFor: 'as yet unclassified' stamp: 'cwp 2/18/2011 17:19'! delimiter ^ self class delimiter! ! !FSStore methodsFor: 'abstract' stamp: 'cwp 2/18/2011 13:07'! directoryAt: aPath ifAbsent: absentBlock nodesDo: aBlock self subclassResponsibility ! ! !FSStore methodsFor: 'error signalling' stamp: 'cwp 2/18/2011 13:49'! directoryDoesNotExist: aPath ^ FSDirectoryDoesNotExist signalWith: aPath! ! !FSStore methodsFor: 'error signalling' stamp: 'cwp 2/18/2011 13:50'! directoryExists: aPath ^ FSDirectoryExists signalWith: aPath! ! !FSStore methodsFor: 'public' stamp: 'cwp 2/19/2011 00:00'! ensureDirectory: aPath (self isDirectory: aPath) ifTrue: [ ^ self ]. self ensureDirectory: aPath parent. self createDirectory: aPath! ! !FSStore methodsFor: 'public' stamp: 'cwp 2/18/2011 13:11'! exists: aPath self nodeAt: aPath ifPresent: [ :entry | ^ true ] ifAbsent: [ ^ false ]. ! ! !FSStore methodsFor: 'error signalling' stamp: 'cwp 2/18/2011 13:50'! fileDoesNotExist: aPath ^ FSFileDoesNotExist signalWith: aPath! ! !FSStore methodsFor: 'error signalling' stamp: 'cwp 2/18/2011 13:51'! fileExists: aPath ^ FSFileExists signalWith: aPath! ! !FSStore methodsFor: 'private' stamp: 'cwp 2/18/2011 12:28'! filename: aByteString matches: aByteString2 ^ aByteString = aByteString2! ! !FSStore methodsFor: 'public' stamp: 'cwp 2/18/2011 13:22'! isDirectory: aPath aPath isRoot ifTrue: [ ^ true ]. self nodeAt: aPath ifPresent: [ :entry | ^ self basicIsDirectory: entry ] ifAbsent: [ ^ false ]. ! ! !FSStore methodsFor: 'public' stamp: 'cwp 2/18/2011 14:35'! isFile: aPath ^ self nodeAt: aPath ifPresent: [ :entry | ^ self basicIsFile: entry ] ifAbsent: [ ^ false ]! ! !FSStore methodsFor: 'abstract' stamp: 'cwp 2/18/2011 12:50'! nodeAt: aPath ifPresent: presentBlock ifAbsent: absentBlock self subclassResponsibility ! ! !FSStore methodsFor: 'abstract' stamp: 'cwp 2/19/2011 01:38'! open "Some kinds of filesystems need to open connections to external resources"! ! !FSStore methodsFor: 'converting' stamp: 'cwp 2/26/2011 17:53'! pathFromString: aString "Use the unix convention by default, since many filesystems are based on it." | in | in := aString readStream. ^ in peek = $/ ifTrue: [in skip: 1. FSAbsolutePath readFrom: in delimiter: self delimiter] ifFalse: [FSRelativePath readFrom: in delimiter: self delimiter]! ! !FSStore methodsFor: 'converting' stamp: 'cwp 2/28/2011 12:28'! printPath: aPath on: out "Use the unix convention by default, since it's the most common." aPath isAbsolute ifTrue: [ out nextPut: $/ ]. ^ aPath printOn: out delimiter: self delimiter! ! !FSStore methodsFor: 'converting' stamp: 'cwp 2/28/2011 12:28'! stringFromPath: aPath ^ String streamContents: [ :out | self printPath: aPath on: out ]! ! Object subclass: #FSStream instanceVariableNames: 'handle position' classVariableNames: '' poolDictionaries: '' category: 'Filesystem-Streams'! !FSStream commentStamp: 'cwp 11/18/2009 11:34' prior: 0! I am an abstract superclass for read- and write-streams that perform IO via a handle rather than by calling primitives directly. My subclasses' provide a cursor on a collection, so that sequences of IO messages can be position independent. handle A subclass of FSHandle. All IO goes through this object. position An integer describing the next index to be accessed.! FSStream subclass: #FSReadStream instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Filesystem-Streams'! !FSReadStream commentStamp: 'cwp 11/18/2009 11:36' prior: 0! I implement (more or less) the ANSI protocol. I provide methods for reading data from a file. ! !FSReadStream methodsFor: 'ansi gettable' stamp: 'cwp 7/29/2009 22:45'! atEnd ^ position - 1 = handle size! ! !FSReadStream methodsFor: 'ansi gettable' stamp: 'cwp 7/29/2009 22:58'! do: aBlock [self atEnd] whileFalse: [aBlock value: self next]! ! !FSReadStream methodsFor: 'ansi gettable' stamp: 'cwp 7/29/2009 22:59'! next | result | result := handle at: position. position := position + 1. ^ result! ! !FSReadStream methodsFor: 'ansi gettable' stamp: 'cwp 7/29/2009 23:03'! next: count | result | result := ByteArray new: count. handle at: position read: result startingAt: 1 count: count. position := position + 1. ^ result! ! !FSReadStream methodsFor: 'squeak' stamp: 'cwp 7/31/2009 00:24'! nextInto: aCollection | count | count := handle at: position read: aCollection startingAt: 1 count: aCollection size. position := position + count. ^ count < aCollection size ifTrue: [aCollection first: count] ifFalse: [aCollection]! ! !FSReadStream methodsFor: 'ansi gettable' stamp: 'cwp 7/29/2009 23:31'! nextLine | char | ^ ByteArray streamContents: [:out | [self atEnd or: [#(13 10) includes: (char := self next)]] whileFalse: [out nextPut: char]. (char = 13 and: [self peek = 10]) ifTrue: [position := position + 1]]. ! ! !FSReadStream methodsFor: 'ansi gettable' stamp: 'cwp 7/30/2009 23:03'! nextMatchFor: anObject ^ self next = anObject! ! !FSReadStream methodsFor: 'ansi gettable' stamp: 'cwp 7/29/2009 23:27'! peek ^ handle at: position! ! !FSReadStream methodsFor: 'ansi gettable' stamp: 'cwp 7/30/2009 23:06'! peekFor: anObject ^ self peek = anObject! ! !FSReadStream methodsFor: 'ansi gettable' stamp: 'cwp 7/30/2009 23:19'! skip: anInteger position := position + anInteger min: handle size + 1! ! !FSReadStream methodsFor: 'ansi gettable' stamp: 'cwp 7/30/2009 23:27'! skipTo: anObject | result | [self atEnd or: [result := (self next = anObject)]] whileFalse. ^ result! ! !FSReadStream methodsFor: 'ansi gettable' stamp: 'cwp 7/30/2009 23:37'! upTo: anObject | byte | ^ ByteArray streamContents: [:out | [self atEnd or: [(byte := self next) = anObject]] whileFalse: [out nextPut: byte]] ! ! !FSStream class methodsFor: 'instance creation' stamp: 'cwp 7/29/2009 22:30'! onHandle: aHandle ^ self new setHandle: aHandle ! ! !FSStream methodsFor: 'public' stamp: 'cwp 7/29/2009 22:29'! close handle close! ! !FSStream methodsFor: 'public' stamp: 'cwp 7/29/2009 22:29'! contents | size contents | size := handle size. contents := ByteArray new: size. handle at: 1 read: contents startingAt: 1 count: size. ^ contents! ! !FSStream methodsFor: 'public' stamp: 'cwp 10/29/2009 09:47'! isOpen ^ handle isOpen! ! !FSStream methodsFor: 'public' stamp: 'cwp 2/5/2011 22:54'! isStream ^ true! ! !FSStream methodsFor: 'public' stamp: 'cwp 10/29/2009 09:47'! open handle open! ! !FSStream methodsFor: 'public' stamp: 'cwp 7/29/2009 22:32'! position ^ position! ! !FSStream methodsFor: 'public' stamp: 'cwp 7/29/2009 22:32'! position: anInteger position := anInteger! ! !FSStream methodsFor: 'initialize-release' stamp: 'cwp 7/29/2009 22:30'! setHandle: aHandle handle := aHandle. position := 1! ! FSStream subclass: #FSWriteStream instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Filesystem-Streams'! !FSWriteStream commentStamp: 'cwp 11/18/2009 11:36' prior: 0! I implement (more or less) the ANSI protocol. I provide methods for writing data to a file.! !FSWriteStream methodsFor: 'ansi puttable' stamp: 'cwp 7/28/2009 22:25'! cr self nextPut: 13! ! !FSWriteStream methodsFor: 'ansi puttable' stamp: 'cwp 7/28/2009 22:22'! flush handle flush! ! !FSWriteStream methodsFor: 'ansi puttable' stamp: 'cwp 7/23/2009 17:03'! nextPut: anObject handle at: position put: anObject. position := position + 1. ^ anObject! ! !FSWriteStream methodsFor: 'ansi puttable' stamp: 'cwp 7/23/2009 22:51'! nextPutAll: aCollection handle at: position write: aCollection startingAt: 1 count: aCollection size. position := position + aCollection size. ^ aCollection! ! !FSWriteStream methodsFor: 'ansi puttable' stamp: 'cwp 7/28/2009 22:26'! space self nextPut: 32! ! !FSWriteStream methodsFor: 'ansi puttable' stamp: 'cwp 7/28/2009 22:28'! tab self nextPut: 9! ! !FSWriteStream methodsFor: 'file' stamp: 'cwp 10/15/2009 22:05'! truncate handle truncateTo: position - 1! ! !FSWriteStream methodsFor: 'file' stamp: 'cwp 10/15/2009 21:49'! truncateTo: anInteger handle truncateTo: anInteger! ! Object subclass: #FSVisitor instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Filesystem-Enumeration'! !FSVisitor commentStamp: 'cwp 11/18/2009 12:25' prior: 0! I am an abstract superclass for objects that can perform operations on directory trees. My subclasses implement the visitor protocol, and process filesystem nodes shown to them by guides.! FSVisitor subclass: #FSCollectVisitor instanceVariableNames: 'out block' classVariableNames: '' poolDictionaries: '' category: 'Filesystem-Enumeration'! !FSCollectVisitor commentStamp: 'cwp 11/18/2009 12:32' prior: 0! I am a visitor that collects objects from the nodes I visit. I take a block similar to those passed to Collection>>collect:. I evaluate the block with DirectoryEntries for the nodes I visit, and collect the objects answered into an array. I can use any guide, and the objects in the array I produce will reflect the order imposed by the guide.! !FSCollectVisitor class methodsFor: 'instance creation' stamp: 'cwp 11/16/2009 10:33'! breadthFirst: aReference ^ self breadthFirst: aReference collect: [:entry | entry]! ! !FSCollectVisitor class methodsFor: 'instance creation' stamp: 'cwp 11/16/2009 10:32'! breadthFirst: aReference collect: aBlock ^ (self collect: aBlock) breadthFirst: aReference! ! !FSCollectVisitor class methodsFor: 'instance creation' stamp: 'cwp 11/16/2009 10:39'! collect: aBlock ^ self basicNew initializeWithBlock: aBlock! ! !FSCollectVisitor class methodsFor: 'instance creation' stamp: 'cwp 11/16/2009 10:36'! postorder: aReference ^ self postorder: aReference collect: [:entry | entry]! ! !FSCollectVisitor class methodsFor: 'instance creation' stamp: 'cwp 11/16/2009 10:35'! postorder: aReference collect: aBlock ^ (self collect: aBlock) postorder: aReference! ! !FSCollectVisitor class methodsFor: 'instance creation' stamp: 'cwp 11/16/2009 10:35'! preorder: aReference ^ self preorder: aReference collect: [:entry | entry]! ! !FSCollectVisitor class methodsFor: 'instance creation' stamp: 'cwp 11/16/2009 10:36'! preorder: aReference collect: aBlock ^ (self collect: aBlock) preorder: aReference! ! !FSCollectVisitor methodsFor: 'ordering' stamp: 'cwp 11/15/2009 07:58'! breadthFirst: aReference ^ self visit: aReference with: (FSBreadthFirstGuide for: self)! ! !FSCollectVisitor methodsFor: 'initialize-release' stamp: 'cwp 11/16/2009 10:38'! initializeWithBlock: aBlock self initialize. block := aBlock! ! !FSCollectVisitor methodsFor: 'ordering' stamp: 'cwp 11/15/2009 07:58'! postorder: aReference ^ self visit: aReference with: (FSPostorderGuide for: self)! ! !FSCollectVisitor methodsFor: 'ordering' stamp: 'cwp 11/15/2009 07:58'! preorder: aReference ^ self visit: aReference with: (FSPreorderGuide for: self)! ! !FSCollectVisitor methodsFor: 'visiting' stamp: 'cwp 11/15/2009 07:59'! visit: aReference with: aGuide out := (Array new: 10) writeStream. aGuide show: aReference. ^ out contents! ! !FSCollectVisitor methodsFor: 'visiting' stamp: 'cwp 11/16/2009 10:38'! visitReference: anEntry out nextPut: (block value: anEntry)! ! FSVisitor subclass: #FSCopyVisitor instanceVariableNames: 'source dest' classVariableNames: '' poolDictionaries: '' category: 'Filesystem-Enumeration'! !FSCopyVisitor commentStamp: 'cwp 11/18/2009 12:30' prior: 0! I create a copy of the directory tree that I visit. I use the PreorderGuide so that I can create directories before creating their contents. ! !FSCopyVisitor class methodsFor: 'instance creation' stamp: 'cwp 10/30/2009 13:44'! copy: source to: dest (self from: source to: dest) visit! ! !FSCopyVisitor class methodsFor: 'instance creation' stamp: 'cwp 10/30/2009 13:41'! from: srcReference to: dstReference ^ self basicNew initializeWithSource: srcReference dest: dstReference! ! !FSCopyVisitor methodsFor: 'visiting' stamp: 'cwp 11/17/2009 21:06'! copyDirectory: aReference | directory | directory := dest resolve: (aReference relativeTo: source). directory createDirectory! ! !FSCopyVisitor methodsFor: 'visiting' stamp: 'cwp 11/15/2009 00:31'! copyFile: aReference | copy | copy := dest resolve: (aReference relativeTo: source). aReference copyTo: copy! ! !FSCopyVisitor methodsFor: 'initialize-release' stamp: 'cwp 10/30/2009 13:42'! initializeWithSource: srcReference dest: dstReference self initialize. source := srcReference. dest := dstReference! ! !FSCopyVisitor methodsFor: 'visiting' stamp: 'cwp 10/30/2009 13:45'! visit (FSPreorderGuide for: self) show: source! ! !FSCopyVisitor methodsFor: 'visiting' stamp: 'cwp 11/16/2009 10:51'! visitDirectory: anEntry | reference | reference := anEntry reference. reference = source ifTrue: [dest ensureDirectory] ifFalse: [self copyDirectory: reference]! ! !FSCopyVisitor methodsFor: 'visiting' stamp: 'cwp 11/16/2009 10:52'! visitFile: anEntry | reference | reference := anEntry reference. reference = source ifTrue: [source copyTo: dest] ifFalse: [self copyFile: reference]! ! FSVisitor subclass: #FSDeleteVisitor instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Filesystem-Enumeration'! !FSDeleteVisitor commentStamp: 'cwp 11/18/2009 12:30' prior: 0! I delete the directory tree that I visit. I use the PostorderGuide so that I can delete files before deleting their containing directories.! !FSDeleteVisitor class methodsFor: 'instance creation' stamp: 'cwp 11/17/2009 13:02'! delete: aReference ^ self new visit: aReference! ! !FSDeleteVisitor methodsFor: 'visiting' stamp: 'cwp 11/17/2009 16:02'! visit: aReference FSPostorderGuide show: aReference to: self! ! !FSDeleteVisitor methodsFor: 'visiting' stamp: 'cwp 11/16/2009 10:53'! visitReference: anEntry anEntry reference delete! ! !FSVisitor methodsFor: 'visiting' stamp: 'cwp 11/15/2009 00:45'! visitDirectory: aReference ^ self visitReference: aReference! ! !FSVisitor methodsFor: 'visiting' stamp: 'cwp 11/15/2009 00:45'! visitFile: aReference ^ self visitReference: aReference! ! !FSVisitor methodsFor: 'visiting' stamp: 'cwp 11/15/2009 00:45'! visitReference: aReference! ! FSFilesystem initialize! FSFileHandle initialize! FSLocator initialize! FSDiskStore initialize!