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'! !String methodsFor: '*filesystem-converting' stamp: 'cwp 11/21/2009 11:30'! asPathWith: anObject ^ anObject pathFromString: self! ! !String methodsFor: '*filesystem-converting' stamp: 'cwp 10/10/2009 17:29'! asResolvedBy: anObject ^ anObject 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 10/27/2009 10:25'! defaultAction | filedir ref | filedir := UIManager default chooseDirectory: 'Where is ', origin, '?'. ref := filedir ifNotNil: [FSDiskFilesystem current referenceTo: filedir fullName]. self resume: ref! ! !FSResolutionRequest methodsFor: 'accessing' stamp: 'cwp 10/27/2009 10:22'! origin: aSymbol origin := aSymbol! ! 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: 'as yet unclassified' stamp: 'cwp 11/15/2009 22:03'! filesystem: fs path: path array: array ^ self filesystem: fs path: path creation: (array at: 2) modification: (array at: 3) isDir: (array at: 4) size: (array at: 5)! ! !FSDirectoryEntry class methodsFor: 'as yet unclassified' stamp: 'cwp 11/15/2009 21:48'! filesystem: fs path: p creation: ct modification: mt isDir: d size: s ^ self reference: (fs referenceTo: p) creation: ct modification: mt isDir: d size:s! ! !FSDirectoryEntry class methodsFor: 'as yet unclassified' stamp: 'cwp 11/15/2009 21:50'! reference: ref creation: cTime modification: mTime isDir: aBoolean size: anInteger ^ self basicNew initializeWithRef: ref creation: cTime modification: mTime isDir: aBoolean size: anInteger! ! !FSDirectoryEntry methodsFor: 'accessing' stamp: 'cwp 11/16/2009 10:49'! basename ^ reference basename! ! !FSDirectoryEntry methodsFor: 'accessing' stamp: 'cwp 11/15/2009 22:06'! creation ^ DateAndTime fromSeconds: creation! ! !FSDirectoryEntry methodsFor: 'accessing' stamp: 'cwp 11/15/2009 22:06'! creationSeconds ^ 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: 'cwp 11/15/2009 21:54'! isDirectory ^ isDirectory! ! !FSDirectoryEntry methodsFor: 'testing' stamp: 'cwp 11/15/2009 22:01'! isFile ^ isDirectory not! ! !FSDirectoryEntry methodsFor: 'accessing' stamp: 'cwp 11/15/2009 22:06'! modification ^ DateAndTime fromSeconds: modification! ! !FSDirectoryEntry methodsFor: 'accessing' stamp: 'cwp 11/15/2009 22:06'! modificationSeconds ^ modification! ! !FSDirectoryEntry methodsFor: 'accessing' stamp: 'cwp 11/15/2009 21:54'! reference ^ reference! ! !FSDirectoryEntry methodsFor: 'accessing' stamp: 'cwp 11/15/2009 21:54'! 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: '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: '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' classVariableNames: '' poolDictionaries: '' category: 'Filesystem-Core'! !FSFilesystem commentStamp: 'cwp 11/18/2009 11:09' prior: 0! I am an abstract super class for filesystem implementations. ! FSFilesystem subclass: #FSDiskFilesystem instanceVariableNames: '' classVariableNames: 'Primitives' poolDictionaries: '' category: 'Filesystem-Disk'! FSDiskFilesystem class instanceVariableNames: 'default'! !FSDiskFilesystem commentStamp: 'cwp 11/18/2009 12:44' prior: 0! I am an abstract superclass for operating-system-provided filesystems. Though I am abstract, I provide most of the functionality for my subclasses, since all platforms use the same primitives. ! FSDiskFilesystem class instanceVariableNames: 'default'! !FSDiskFilesystem class methodsFor: 'accessing' stamp: 'cwp 9/22/2009 09:41'! / anObject ^ self current root / anObject! ! !FSDiskFilesystem class methodsFor: 'instance creation' stamp: 'cwp 10/10/2009 18:25'! createDefault ^ self new! ! !FSDiskFilesystem class methodsFor: 'instance creation' stamp: 'cwp 10/10/2009 18:22'! current ^ self currentClass default! ! !FSDiskFilesystem class methodsFor: 'instance creation' stamp: 'cwp 10/11/2009 12:02'! currentClass ^ SmalltalkImage current platformName = 'Win32' ifTrue: [FSWindowsFilesystem] ifFalse: [FSUnixFilesystem]! ! !FSDiskFilesystem class methodsFor: 'instance creation' stamp: 'cwp 10/10/2009 18:25'! default ^ default ifNil: [default := self createDefault]! ! !FSDiskFilesystem class methodsFor: 'references' stamp: 'cwp 10/11/2009 20:13'! imageDirectory ^ self imageFile parent! ! !FSDiskFilesystem class methodsFor: 'references' stamp: 'cwp 11/21/2009 11:30'! imageFile ^ self current referenceFromString: Primitives imageFile! ! !FSDiskFilesystem class methodsFor: 'initialize-release' stamp: 'lr 4/24/2010 13:59'! initialize self useFilePlugin. Smalltalk addToStartUpList: self! ! !FSDiskFilesystem class methodsFor: 'testing' stamp: 'cwp 11/21/2009 12:22'! isCurrentClass ^ FSDiskFilesystem currentClass = self! ! !FSDiskFilesystem class methodsFor: 'instance creation' stamp: 'lr 4/24/2010 14:03'! reset default := nil! ! !FSDiskFilesystem class methodsFor: 'accessing' stamp: 'cwp 10/11/2009 11:11'! root ^ self current root! ! !FSDiskFilesystem class methodsFor: 'initialize-release' stamp: 'lr 4/24/2010 14:03'! startUp: resuming resuming ifTrue: [ self withAllSubclassesDo: [ :each | each reset ] ]! ! !FSDiskFilesystem class methodsFor: 'initialize-release' stamp: 'cwp 7/20/2009 17:39'! useFilePlugin Primitives := FSFilePluginPrims new! ! !FSDiskFilesystem class methodsFor: 'references' stamp: 'cwp 10/26/2009 11:22'! vmDirectory ^ self vmFile parent! ! !FSDiskFilesystem class methodsFor: 'references' stamp: 'cwp 11/21/2009 11:30'! vmFile ^ self current referenceFromString: (SmalltalkImage current getSystemAttribute: 0)! ! !FSDiskFilesystem methodsFor: 'comparing' stamp: 'cwp 7/24/2009 00:41'! = other ^ self species = other species! ! !FSDiskFilesystem methodsFor: 'private' stamp: 'cwp 7/18/2009 01:26'! basicIsDirectory: anEntry ^ anEntry at: 4! ! !FSDiskFilesystem methodsFor: 'private' stamp: 'cwp 7/18/2009 01:29'! basicIsFile: anEntry ^ (anEntry at: 4) not! ! !FSDiskFilesystem methodsFor: 'public' stamp: 'cwp 11/21/2009 11:31'! basicOpen: aPath writable: aBoolean ^ Primitives open: (self stringFromPath: aPath) writable: aBoolean! ! !FSDiskFilesystem methodsFor: 'public' stamp: 'cwp 11/17/2009 19:46'! childrenAt: anObject | path | path := self resolve: anObject. ^ Array streamContents: [ :out | self directoryAt: path ifAbsent: [ self directoryDoesNotExist: path ] nodesDo: [ :entry | out nextPut: (self referenceTo: path / entry first) ] ]! ! !FSDiskFilesystem methodsFor: 'public' stamp: 'cwp 11/21/2009 11:31'! createDirectory: anObject | parent path result | path := self resolve: anObject. result := Primitives createDirectory: (self stringFromPath: path). result ifNil: [ parent := path parent. (self exists: path) ifTrue: [ ^ self nodeExists: path ]. (self isDirectory: parent) ifFalse: [ ^ self directoryDoesNotExist: parent ]. self primitiveFailed ]! ! !FSDiskFilesystem methodsFor: 'public' stamp: 'cwp 11/21/2009 11:31'! delete: anObject | path pathString | path := self resolve: anObject. pathString := self stringFromPath: path. (self isDirectory: path) ifTrue: [ Primitives deleteDirectory: (self stringFromPath: path) ] ifFalse: [ StandardFileStream retryWithGC: [ Primitives deleteFile: pathString ] until: [ :result | result notNil ] forFileNamed: pathString ]! ! !FSDiskFilesystem methodsFor: 'private' stamp: 'cwp 11/21/2009 11:31'! directoryAt: aPath ifAbsent: absentBlock nodesDo: aBlock | index pathString entry | index := 1. pathString := self stringFromPath: aPath. entry := Primitives lookupEntryIn: pathString index: index. entry = #badDirectoryPath ifTrue: [ ^ absentBlock value ]. [ entry isNil ] whileFalse: [ aBlock value: entry. index := index + 1. entry := Primitives lookupEntryIn: pathString index: index ]! ! !FSDiskFilesystem methodsFor: 'public' stamp: 'cwp 11/17/2009 19:46'! entriesAt: anObject | path entry | path := self resolve: anObject. ^ Array streamContents: [ :out | self directoryAt: path ifAbsent: [ self directoryDoesNotExist: path ] nodesDo: [ :node | entry := self entryFromNode: node atPath: path / (node at: 1). out nextPut: entry ] ]! ! !FSDiskFilesystem methodsFor: 'private' stamp: 'cwp 11/16/2009 00:19'! entryFromNode: node atPath: path ^ FSDirectoryEntry filesystem: self path: path array: node! ! !FSDiskFilesystem methodsFor: 'comparing' stamp: 'cwp 7/24/2009 00:41'! hash ^ self species hash! ! !FSDiskFilesystem methodsFor: 'private' stamp: 'cwp 11/15/2009 21:40'! 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 filenname: (entry at: 1) matches: name) ifTrue: [ ^ presentBlock value: entry ] ]. ^ absentBlock value! ! !FSDiskFilesystem methodsFor: 'public' stamp: 'cwp 10/11/2009 21:21'! open: anObject writable: aBoolean | path | path := self resolve: anObject. ^ FSFileHandle open: (FSReference filesystem: self path: path) writable: aBoolean ! ! !FSDiskFilesystem methodsFor: 'private' stamp: 'cwp 11/15/2009 21:40'! rootNode ^ #('' 0 0 true 0 )! ! FSDiskFilesystem subclass: #FSUnixFilesystem instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Filesystem-Disk'! !FSUnixFilesystem commentStamp: 'cwp 11/18/2009 12:49' prior: 0! I provide an interfact to Unix filesystems. By default, my working directory is the directory that contains the image file. I use the standard unix path delimiter, $/.! !FSUnixFilesystem class methodsFor: 'as yet unclassified' stamp: 'cwp 11/21/2009 12:22'! putRootsOn: aStream self isCurrentClass ifTrue: [ aStream nextPut: self current root ]! ! !FSUnixFilesystem methodsFor: 'public' stamp: 'cwp 1/13/2009 21:35'! delimiter ^ $/! ! !FSUnixFilesystem methodsFor: 'private' stamp: 'cwp 10/11/2009 22:33'! forReferencePrintOn: aStream ! ! !FSUnixFilesystem methodsFor: 'private' stamp: 'cwp 11/21/2009 11:30'! initialize workingDirectory := (self pathFromString: Primitives imageFile) parent! ! FSDiskFilesystem subclass: #FSWindowsFilesystem instanceVariableNames: 'disk' classVariableNames: 'Disks' poolDictionaries: '' category: 'Filesystem-Disk'! !FSWindowsFilesystem commentStamp: 'cwp 11/18/2009 12:57' prior: 0! I provide an interface to Windows filesystems. My instances represent specific drives, such as C: or D:. A typical Windows system will have more than one filesystem, so I keep track of the "current" filesystem as well as the current directory in each filesystem. ! !FSWindowsFilesystem class methodsFor: 'as yet unclassified' stamp: 'cwp 10/11/2009 22:43'! changeDisk: aString default := self disk: aString! ! !FSWindowsFilesystem class methodsFor: 'instance creation' stamp: 'cwp 10/11/2009 12:52'! createDefault ^ self newForDisk: 'C'! ! !FSWindowsFilesystem class methodsFor: 'as yet unclassified' stamp: 'cwp 11/21/2009 12:27'! currentDisksDo: aBlock | index entry | index := 1. [entry := Primitives lookupEntryIn: '' index: index. entry isNil] whileFalse: [aBlock value: entry first allButLast. index := index + 1]! ! !FSWindowsFilesystem class methodsFor: 'as yet unclassified' stamp: 'cwp 11/20/2009 20:55'! disk: aString ^ Disks at: aString ifAbsentPut: [ self newForDisk: aString ]! ! !FSWindowsFilesystem class methodsFor: 'as yet unclassified' stamp: 'cwp 11/21/2009 09:11'! disks ^ Disks values asArray sort: [:a :b | a printString < b printString]! ! !FSWindowsFilesystem class methodsFor: 'initialize-release' stamp: 'cwp 11/20/2009 20:51'! initialize Disks := Dictionary new. ! ! !FSWindowsFilesystem class methodsFor: 'as yet unclassified' stamp: 'cwp 11/20/2009 20:52'! newForDisk: aString ^ self new initializeWithDisk: aString! ! !FSWindowsFilesystem class methodsFor: 'as yet unclassified' stamp: 'cwp 11/21/2009 12:27'! putRootsOn: aStream self isCurrentClass ifTrue: [self currentDisksDo: [:disk | aStream nextPut: (self disk: disk) root]]! ! !FSWindowsFilesystem methodsFor: 'navigating' stamp: 'cwp 10/27/2009 20:54'! / anObject ^ self root / anObject! ! !FSWindowsFilesystem methodsFor: 'comparing' stamp: 'cwp 11/21/2009 12:29'! = other ^ self species = other species and: [disk = other disk]! ! !FSWindowsFilesystem methodsFor: 'public' stamp: 'cwp 7/17/2009 19:19'! delimiter ^ $\! ! !FSWindowsFilesystem methodsFor: 'accessing' stamp: 'cwp 11/21/2009 11:57'! disk ^ disk! ! !FSWindowsFilesystem methodsFor: 'printing' stamp: 'cwp 10/11/2009 22:33'! forReferencePrintOn: aStream aStream nextPutAll: disk; nextPut: $:! ! !FSWindowsFilesystem methodsFor: 'comparing' stamp: 'cwp 11/21/2009 12:29'! hash ^ disk hash! ! !FSWindowsFilesystem methodsFor: 'initialize-release' stamp: 'cwp 11/21/2009 11:30'! initializeWithDisk: aString | pathString | disk := aString. pathString := Primitives imageFile. (pathString first: 1) = disk ifTrue: [ workingDirectory := (self pathFromString: pathString) parent ] ifFalse: [ workingDirectory := FSPath root ]! ! !FSWindowsFilesystem methodsFor: 'converting' stamp: 'cwp 11/21/2009 11:30'! pathFromString: aString | in | in := aString readStream. (aString at: 2) = $: ifTrue: [ in skip: 2 ]. ^ FSPath readFrom: in delimiter: self delimiter! ! !FSWindowsFilesystem methodsFor: 'printing' stamp: 'cwp 10/11/2009 12:49'! printOn: aStream aStream nextPutAll: disk. aStream nextPut: $:! ! !FSWindowsFilesystem methodsFor: 'converting' stamp: 'cwp 11/21/2009 11:30'! referenceFromString: aString | in fs letter | in := aString readStream. (aString at: 2) = $: ifFalse: [ fs := self ] ifTrue: [ letter := in next: 1. in skip: 1. fs := Disks at: letter ifAbsentPut: [ self class newForDisk: letter ] ]. ^ FSReference filesystem: fs path: (FSPath readFrom: in delimiter: self delimiter)! ! !FSWindowsFilesystem methodsFor: 'converting' stamp: 'cwp 11/21/2009 11:31'! stringFromPath: aPath ^ String streamContents: [ :out | out nextPutAll: disk; nextPut: $:. aPath printOn: out delimiter: self delimiter ]! ! !FSFilesystem class methodsFor: 'as yet unclassified' stamp: 'cwp 9/22/2009 09:41'! / anObject ^ self new root / anObject! ! !FSFilesystem class methodsFor: 'as yet unclassified' stamp: 'cwp 11/21/2009 12:20'! putAllRootsOn: aStream self putRootsOn: aStream. self subclassesDo: [:class | class putAllRootsOn: aStream]! ! !FSFilesystem class methodsFor: 'as yet unclassified' stamp: 'cwp 11/21/2009 12:20'! putRootsOn: aStream ! ! !FSFilesystem methodsFor: 'private' stamp: 'cwp 9/22/2009 09:47'! basicCopy: source ifAbsent: aBlock to: destination ifPresent: pBlock | in out buffer | [in := self readStreamOn: source. in ifNil: [aBlock value]. (self exists: destination) ifTrue: pBlock. out := self 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]]! ! !FSFilesystem methodsFor: 'accessing' stamp: 'cwp 7/18/2009 00:53'! changeDirectory: aPath self workingDirectory: (self resolve: aPath)! ! !FSFilesystem methodsFor: 'public' stamp: 'cwp 11/15/2009 21:25'! childrenAt: anObject self subclassResponsibility! ! !FSFilesystem methodsFor: 'public' stamp: 'cwp 9/21/2009 15:18'! close "Some kinds of filesystems need to open connections to external resources"! ! !FSFilesystem methodsFor: 'public' stamp: 'cwp 10/10/2009 17:34'! copy: sourcePath ifAbsent: aBlock to: destPath ifPresent: pBlock | source destination | source := self resolve: sourcePath. destination := self resolve: destPath. self basicCopy: source ifAbsent: aBlock to: destination ifPresent: pBlock! ! !FSFilesystem methodsFor: 'public' stamp: 'cwp 7/24/2009 00:27'! copy: sourcePath to: destPath self copy: sourcePath ifAbsent: [self fileDoesNotExist: sourcePath] to: destPath ifPresent: [self fileExists: destPath]! ! !FSFilesystem methodsFor: 'public' stamp: 'cwp 7/18/2009 01:15'! createDirectory: aPath self subclassResponsibility! ! !FSFilesystem methodsFor: 'public' stamp: 'cwp 7/20/2009 08:39'! delete: aPath self subclassResponsibility ! ! !FSFilesystem methodsFor: 'public' stamp: 'cwp 7/17/2009 19:20'! delimiter self subclassResponsibility! ! !FSFilesystem methodsFor: 'private' stamp: 'cwp 11/15/2009 21:32'! directoryAt: aPath ifAbsent: absentBlock nodesDo: aBlock self subclassResponsibility! ! !FSFilesystem methodsFor: 'error handling' stamp: 'cwp 11/17/2009 19:46'! directoryDoesNotExist: path FSDirectoryDoesNotExist signalWith: (self referenceTo: path)! ! !FSFilesystem methodsFor: 'error handling' stamp: 'cwp 11/17/2009 19:47'! directoryExists: path FSDirectoryExists signalWith: (self referenceTo: path)! ! !FSFilesystem methodsFor: 'public' stamp: 'cwp 11/17/2009 21:01'! ensureDirectory: aPath (self isDirectory: aPath) ifFalse: [self ensureDirectory: aPath parent. self createDirectory: aPath]! ! !FSFilesystem methodsFor: 'public' stamp: 'cwp 11/15/2009 22:43'! entryAt: anObject | path | path := self resolve: anObject. ^ self nodeAt: path ifPresent: [:node | self entryFromNode: node atPath: path] ifAbsent: [self fileDoesNotExist: path]! ! !FSFilesystem methodsFor: 'private' stamp: 'cwp 11/15/2009 22:21'! entryFromNode: node atPath: path self subclassResponsibility! ! !FSFilesystem methodsFor: 'public' stamp: 'cwp 11/15/2009 21:31'! exists: anObject | path | path := self resolve: anObject. self nodeAt: path ifPresent: [ :entry | ^ true ] ifAbsent: [ ^ false ]! ! !FSFilesystem methodsFor: 'error handling' stamp: 'cwp 11/14/2009 23:38'! fileDoesNotExist: path FSFileDoesNotExist signalWith: (self referenceTo: path)! ! !FSFilesystem methodsFor: 'error handling' stamp: 'cwp 11/14/2009 23:35'! fileExists: path FSFileExists signalWith: (self referenceTo: path)! ! !FSFilesystem methodsFor: 'private' stamp: 'cwp 11/15/2009 21:31'! filenname: aByteString matches: aByteString2 ^ aByteString = aByteString2! ! !FSFilesystem methodsFor: 'printing' stamp: 'cwp 7/17/2009 19:20'! forReferencePrintOn: aStream self subclassResponsibility! ! !FSFilesystem methodsFor: 'initialize-release' stamp: 'cwp 7/18/2009 00:54'! initialize workingDirectory := FSPath root! ! !FSFilesystem methodsFor: 'public' stamp: 'cwp 11/15/2009 21:31'! isDirectory: anObject | path | path := self resolve: anObject. path isRoot ifTrue: [ ^ true ]. self nodeAt: path ifPresent: [ :entry | ^ self basicIsDirectory: entry ] ifAbsent: [ ^ false ]! ! !FSFilesystem methodsFor: 'public' stamp: 'cwp 11/15/2009 21:31'! isFile: anObject | path | path := self resolve: anObject. self nodeAt: path ifPresent: [ :entry | ^ self basicIsFile: entry ] ifAbsent: [ ^ false ]! ! !FSFilesystem methodsFor: 'private' stamp: 'cwp 11/15/2009 21:31'! nodeAt: aPath ifPresent: presentBlock ifAbsent: absentBlock self subclassResponsibility! ! !FSFilesystem methodsFor: 'error handling' stamp: 'cwp 11/17/2009 19:46'! nodeExists: aPath (self isFile: aPath) ifTrue: [self fileExists: aPath] ifFalse: [self directoryExists: aPath]! ! !FSFilesystem methodsFor: 'public' stamp: 'cwp 9/21/2009 15:17'! open "Some kinds of filesystems need to open connections to external resources"! ! !FSFilesystem methodsFor: 'public' stamp: 'cwp 7/22/2009 08:21'! open: aPath writable: aBoolean self subclassResponsibility! ! !FSFilesystem methodsFor: 'converting' stamp: 'cwp 11/21/2009 11:30'! pathFromObject: anObject ^ anObject asPathWith: self! ! !FSFilesystem methodsFor: 'converting' stamp: 'cwp 11/21/2009 11:30'! pathFromString: aString ^ FSPath readFrom: aString readStream delimiter: self delimiter! ! !FSFilesystem methodsFor: 'printing' stamp: 'cwp 7/17/2009 19:21'! printPath: aPath on: aStream aPath printOn: aStream delimiter: self delimiter! ! !FSFilesystem methodsFor: 'public' stamp: 'cwp 7/31/2009 00:26'! readStreamOn: anObject ^ (self open: anObject writable: false) readStream.! ! !FSFilesystem methodsFor: 'converting' stamp: 'cwp 11/21/2009 11:30'! referenceFromString: aString ^ FSReference filesystem: self path: (self pathFromString: aString)! ! !FSFilesystem methodsFor: 'public' stamp: 'cwp 11/21/2009 11:30'! referenceTo: anObject ^ FSReference filesystem: self path: (self pathFromObject: anObject)! ! !FSFilesystem methodsFor: 'public' stamp: 'cwp 10/10/2009 17:28'! resolve: anObject ^ anObject asResolvedBy: self! ! !FSFilesystem methodsFor: 'navigating' stamp: 'cwp 10/10/2009 17:29'! resolvePath: aPath ^ 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 11/21/2009 11:30'! resolveString: aString ^ workingDirectory resolvePath: (self pathFromString: aString)! ! !FSFilesystem methodsFor: 'accessing' stamp: 'cwp 9/20/2009 22:27'! root ^ self referenceTo: FSPath root! ! !FSFilesystem methodsFor: 'converting' stamp: 'cwp 11/21/2009 11:31'! stringFromPath: aPath ^ aPath printWithDelimiter: self delimiter! ! !FSFilesystem methodsFor: 'accessing' stamp: 'lr 2/14/2010 09:48'! working ^ self referenceTo: self workingDirectory! ! !FSFilesystem methodsFor: 'accessing' stamp: 'cwp 7/18/2009 00:53'! workingDirectory ^ workingDirectory! ! !FSFilesystem methodsFor: 'accessing' stamp: 'cwp 7/18/2009 00:59'! workingDirectory: aPath aPath isAbsolute ifFalse: [self error: 'Cannot set the working directory to a relative path']. workingDirectory := aPath! ! !FSFilesystem methodsFor: 'public' stamp: 'cwp 7/28/2009 22:59'! writeStreamOn: anObject ^ (self open: anObject writable: true) writeStream.! ! FSFilesystem subclass: #FSMemoryFilesystem instanceVariableNames: 'root' classVariableNames: '' poolDictionaries: '' category: 'Filesystem-Memory'! !FSMemoryFilesystem commentStamp: 'cwp 11/18/2009 23:58' prior: 0! I implement the filesystem protocol, but store data within the image, rather than on disk. I model Directories as Dictionaries, and files as ByteArrays. root A Dictionary that represents the root of the filesystem. ! !FSMemoryFilesystem methodsFor: 'private' stamp: 'cwp 11/17/2009 19:46'! basicCopy: source ifAbsent: aBlock to: destination ifPresent: pBlock self nodeAt: source ifPresent: [ :bytes | (self basicIsFile: bytes) ifFalse: aBlock. self nodeAt: destination parent ifPresent: [ :dict | (self basicIsDirectory: dict) ifFalse: [ self directoryDoesNotExist: destination parent ]. (dict includesKey: destination basename) ifTrue: pBlock. dict at: destination basename put: bytes copy ] ifAbsent: [ self directoryDoesNotExist: destination parent ] ] ifAbsent: aBlock! ! !FSMemoryFilesystem methodsFor: 'private' stamp: 'cwp 7/18/2009 01:31'! basicIsDirectory: entry ^ entry isDictionary! ! !FSMemoryFilesystem methodsFor: 'private' stamp: 'cwp 7/18/2009 01:31'! basicIsFile: entry ^ entry isDictionary not! ! !FSMemoryFilesystem methodsFor: 'private' stamp: 'cwp 11/15/2009 21:31'! basicOpen: anObject writable: aBoolean | path | path := self resolve: anObject. ^ self nodeAt: path ifPresent: [ :bytes | bytes ] ifAbsent: [ aBoolean ifFalse: [ self fileDoesNotExist: path ] ifTrue: [ self createFile: path ] ]! ! !FSMemoryFilesystem methodsFor: 'public' stamp: 'cwp 11/17/2009 19:46'! childrenAt: anObject | path ref | path := self resolve: anObject. ^ Array streamContents: [ :out | self directoryAt: path ifAbsent: [ self directoryDoesNotExist: path ] nodesDo: [ :association | ref := self referenceTo: path / association key. out nextPut: ref ] ]! ! !FSMemoryFilesystem methodsFor: 'public' stamp: 'cwp 11/17/2009 19:48'! createDirectory: anObject | parent path | path := self resolve: anObject. parent := path parent. self nodeAt: parent ifPresent: [:dict | dict at: path basename ifPresent: [:node | (node isDictionary ifTrue: [FSDirectoryExists] ifFalse: [FSFileExists]) signalWith: path]. dict at: path basename put: Dictionary new] ifAbsent: [self directoryDoesNotExist: parent]! ! !FSMemoryFilesystem methodsFor: 'private' stamp: 'cwp 11/17/2009 19:46'! createFile: path ^ self nodeAt: path parent ifPresent: [ :dict | (self basicIsDirectory: dict) ifTrue: [ dict at: path basename put: ByteArray new ] ] ifAbsent: [ self directoryDoesNotExist: path parent ]! ! !FSMemoryFilesystem methodsFor: 'public' stamp: 'cwp 11/15/2009 21:31'! delete: anObject | path | path := self resolve: anObject. self nodeAt: path parent ifPresent: [ :dict | dict removeKey: path basename ] ifAbsent: [ ]! ! !FSMemoryFilesystem methodsFor: 'public' stamp: 'cwp 7/17/2009 19:29'! delimiter ^ $/! ! !FSMemoryFilesystem methodsFor: 'private' stamp: 'cwp 11/15/2009 22:49'! directoryAt: aPath ifAbsent: absentBlock nodesDo: aBlock self nodeAt: aPath ifPresent: [ :directory | directory isDictionary ifFalse: [ ^ absentBlock value ]. directory associationsDo: aBlock ] ifAbsent: absentBlock! ! !FSMemoryFilesystem methodsFor: 'public' stamp: 'cwp 11/17/2009 19:46'! entriesAt: anObject | path entry | path := self resolve: anObject. ^ Array streamContents: [ :out | self directoryAt: path ifAbsent: [ self directoryDoesNotExist: path ] nodesDo: [ :association | entry := self entryFromNode: association value atPath: path / association key. out nextPut: entry ] ]! ! !FSMemoryFilesystem methodsFor: 'private' stamp: 'cwp 11/15/2009 22:59'! entryFromNode: node atPath: aPath ^ FSDirectoryEntry filesystem: self path: aPath creation: 0 modification: 0 isDir: node isDictionary size: (node isDictionary ifTrue: [0] ifFalse: [node size])! ! !FSMemoryFilesystem methodsFor: 'printing' stamp: 'cwp 10/11/2009 22:37'! forReferencePrintOn: aStream aStream nextPutAll: 'memory:'! ! !FSMemoryFilesystem methodsFor: 'private' stamp: 'cwp 7/19/2009 22:12'! growFile: anObject to: anInteger ^ self replaceFile: anObject in: [:bytes | (bytes class new: anInteger) replaceFrom: 1 to: bytes size with: bytes startingAt: 1; yourself]! ! !FSMemoryFilesystem methodsFor: 'initialize-release' stamp: 'cwp 7/18/2009 01:11'! initialize super initialize. root := Dictionary new! ! !FSMemoryFilesystem methodsFor: 'private' stamp: 'cwp 11/15/2009 21:31'! nodeAt: aPath ifPresent: presentBlock ifAbsent: absentBlock | current | current := root. aPath do: [ :segment | current isDictionary ifTrue: [ current := current at: segment ifAbsent: [ ^ absentBlock value ] ] ifFalse: [ ^ absentBlock value ] ]. ^ presentBlock value: current! ! !FSMemoryFilesystem methodsFor: 'public' stamp: 'cwp 8/29/2009 10:15'! open: anObject writable: aBoolean | path | path := self resolve: anObject. ^ FSMemoryHandle open: (self referenceTo: path) writable: aBoolean ! ! !FSMemoryFilesystem methodsFor: 'public' stamp: 'cwp 11/15/2009 21:31'! openFileStream: aPath writable: aBoolean | path bytes | path := self resolve: aPath. bytes := self nodeAt: path ifPresent: [ :array | array ] ifAbsent: [ self createFile: path ]. ^ FSMemoryFileStream on: bytes filesystem: self path: path! ! !FSMemoryFilesystem methodsFor: 'private' stamp: 'cwp 11/15/2009 21:31'! replaceFile: anObject in: aBlock | path | path := self resolve: anObject. ^ 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 ]! ! !FSMemoryFilesystem methodsFor: 'private' stamp: 'cwp 7/19/2009 22:13'! truncateFile: anObject to: anInteger ^ self replaceFile: anObject in: [ :bytes | bytes first: anInteger ]! ! FSMemoryFilesystem subclass: #FSZipFilesystem instanceVariableNames: 'reference' classVariableNames: '' poolDictionaries: '' category: 'Filesystem-Zip'! !FSZipFilesystem commentStamp: 'cwp 11/19/2009 00:05' prior: 0! I am a filesystem interface to a ZipArchive. ! !FSZipFilesystem class methodsFor: 'instance creation' stamp: 'cwp 11/17/2009 16:42'! atReference: aReference ^ self basicNew initializeWithReference: aReference! ! !FSZipFilesystem methodsFor: 'public' stamp: 'lr 2/20/2010 23:49'! close | archive stream | archive := ZipArchive new. self 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. reference writeStreamDo: [ :output | output nextPutAll: stream contents ]! ! !FSZipFilesystem methodsFor: 'initialize-release' stamp: 'lr 2/20/2010 22:55'! initializeWithReference: aReference self initialize. reference := aReference! ! !FSZipFilesystem methodsFor: 'public' stamp: 'lr 2/20/2010 23:12'! open | archive | reference exists ifFalse: [ ^ self ]. archive := ZipArchive new. reference readStreamDo: [ :input | archive readFrom: input contents readStream. archive members do: [ :member | | ref | ref := self referenceTo: (self pathFromMember: member). member isDirectory ifTrue: [ ref ensureDirectory ] ifFalse: [ ref parent ensureDirectory. ref writeStreamDo: [ :stream | member rewindData; copyRawDataTo: stream ] ] ] ]! ! !FSZipFilesystem methodsFor: 'private' stamp: 'cwp 9/22/2009 23:29'! pathFromMember: anArchiveMember | path | path := FSPath root resolve: anArchiveMember fileName. ^ path basename isEmpty ifTrue: [path parent] ifFalse: [path]! ! !FSZipFilesystem methodsFor: 'accessing' stamp: 'cwp 9/21/2009 17:48'! reference ^ reference! ! 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: 'as yet unclassified' stamp: 'cwp 10/29/2009 19:27'! for: aVisitor ^ self basicNew initializeWithVisitor: aVisitor! ! !FSGuide class methodsFor: 'as yet unclassified' stamp: 'cwp 11/17/2009 11:58'! show: aReference to: aVisitor ^ (self for: aVisitor) show: aReference! ! !FSGuide methodsFor: 'initialize-release' stamp: 'cwp 10/29/2009 23:51'! 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: 'cwp 10/29/2009 23:52'! whileNotDoneDo: aBlock [work isEmpty] whileFalse: aBlock! ! 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 1/31/2010 22:43'! growTo: anInteger bytes := reference filesystem growFile: reference 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 7/26/2009 14:29'! truncateTo: anInteger bytes := reference filesystem truncateFile: reference path to: anInteger. size := anInteger! ! Object subclass: #FSLocator instanceVariableNames: 'origin path' classVariableNames: 'Resolver' poolDictionaries: '' category: 'Filesystem-Core'! !FSLocator commentStamp: 'cwp 11/18/2009 11:16' 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. 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: '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: 'class initialization' stamp: 'cwp 11/20/2009 15:01'! initialize Smalltalk addToStartUpList: self. self startUp: true! ! !FSLocator class methodsFor: 'instance creation' stamp: 'cwp 10/25/2009 09:55'! origin: aSymbol ^ self origin: aSymbol path: FSPath empty! ! !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: 'cwp 11/20/2009 15:00'! startUp: resuming resuming ifTrue: [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: '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: 'cwp 10/27/2009 10:27'! printOn: aStream | fs | aStream nextPut: ${; nextPutAll: origin; nextPut: $}. path isWorkingDirectory ifFalse: [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 11/18/2009 11:19' prior: 0! I an 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.! !FSPath class methodsFor: 'instance creation' stamp: 'cwp 10/28/2009 03:38'! * aString ^ self with: aString! ! !FSPath class methodsFor: 'instance creation' stamp: 'cwp 12/23/2008 14:15'! / aString ^ self root / 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: 'instance creation' stamp: 'cwp 10/11/2009 13:09'! empty ^ self new! ! !FSPath class methodsFor: 'accessing' stamp: 'cwp 12/23/2008 11:23'! extensionDelimiter ^ $.! ! !FSPath class methodsFor: 'instance creation' stamp: 'cwp 10/10/2009 17:51'! parent ^ self 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 10/11/2009 16:39'! readFrom: aStream delimiter: 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. ^ FSPath withAll: (self canonicalizeElements: elements)! ! !FSPath class methodsFor: 'instance creation' stamp: 'cwp 10/11/2009 13:04'! root ^ self with: ''! ! !FSPath class methodsFor: 'instance creation' stamp: 'cwp 10/10/2009 17:43'! with: aString | inst | inst := self new: 1. inst at: 1 put: aString. ^ inst! ! !FSPath class methodsFor: 'instance creation' 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 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 9/21/2009 22:58'! asReference ^ FSDiskFilesystem current referenceTo: self! ! !FSPath methodsFor: 'navigating' stamp: 'cwp 9/22/2009 09:08'! asResolvedBy: anObject ^ anObject resolvePath: self! ! !FSPath methodsFor: 'accessing' stamp: 'cwp 12/15/2008 14:02'! basename ^ 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: 'accessing' 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: 'cwp 12/23/2008 11:25'! extensionDelimiter ^ self class extensionDelimiter! ! !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 7/18/2009 01:03'! isAbsolute ^ self size > 0 and: [(self at: 1) = '']! ! !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: 'cwp 12/13/2008 21:00'! isRelative ^ self isAbsolute not! ! !FSPath methodsFor: 'testing' stamp: 'cwp 7/18/2009 00:41'! isRoot ^ self size = 1 and: [self isAbsolute]! ! !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 11/21/2009 09:08'! printOn: aStream delimiter: aCharacter self isRoot ifTrue: [aStream nextPut: aCharacter. ^ self]. self isWorkingDirectory ifTrue: [aStream nextPut: $.. ^ self]. (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 11/15/2009 00:12'! relativeToPath: aPath | prefix relative | aPath isRelative ifTrue: [^ aPath]. prefix := self lengthOfStemWith: aPath. relative := FSPath parents: (aPath size - prefix). prefix + 1 to: self size do: [:i | relative := relative / (self at: i)]. ^ relative! ! !FSPath methodsFor: 'navigating' stamp: 'cwp 11/16/2009 10:19'! resolve ^ self! ! !FSPath methodsFor: 'navigating' stamp: 'cwp 10/26/2009 01:03'! resolve: anObject ^ anObject asResolvedBy: self! ! !FSPath methodsFor: 'navigating' stamp: 'cwp 9/22/2009 09:04'! resolvePath: aPath | 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 10/25/2009 21:42'! resolveString: aString ^ 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! ! Object subclass: #FSReference instanceVariableNames: 'filesystem path' classVariableNames: '' poolDictionaries: '' category: 'Filesystem-Core'! !FSReference commentStamp: 'cwp 11/18/2009 11:22' 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. ! !FSReference class methodsFor: 'cross platform' stamp: 'cwp 11/20/2009 23:00'! / aString ^ FSDiskFilesystem current root / aString! ! !FSReference class methodsFor: 'windows' stamp: 'cwp 11/20/2009 21:09'! A ^ self filesystem: (FSWindowsFilesystem disk: 'A') path: FSPath root ! ! !FSReference class methodsFor: 'windows' stamp: 'cwp 11/20/2009 21:09'! B ^ self filesystem: (FSWindowsFilesystem disk: 'B') path: FSPath root ! ! !FSReference class methodsFor: 'windows' stamp: 'cwp 11/20/2009 21:09'! C ^ self filesystem: (FSWindowsFilesystem disk: 'C') path: FSPath root ! ! !FSReference class methodsFor: 'windows' stamp: 'cwp 11/20/2009 21:09'! D ^ self filesystem: (FSWindowsFilesystem disk: 'D') path: FSPath root ! ! !FSReference class methodsFor: 'windows' stamp: 'cwp 11/20/2009 21:09'! E ^ self filesystem: (FSWindowsFilesystem disk: 'E') path: FSPath root ! ! !FSReference class methodsFor: 'windows' stamp: 'cwp 11/20/2009 21:09'! F ^ self filesystem: (FSWindowsFilesystem disk: 'F') path: FSPath root ! ! !FSReference class methodsFor: 'windows' stamp: 'cwp 11/20/2009 21:09'! G ^ self filesystem: (FSWindowsFilesystem disk: 'G') path: FSPath root ! ! !FSReference class methodsFor: 'windows' stamp: 'cwp 11/20/2009 21:09'! H ^ self filesystem: (FSWindowsFilesystem disk: 'H') path: FSPath root ! ! !FSReference class methodsFor: 'windows' stamp: 'cwp 11/20/2009 21:09'! I ^ self filesystem: (FSWindowsFilesystem disk: 'I') path: FSPath root ! ! !FSReference class methodsFor: 'windows' stamp: 'cwp 11/20/2009 21:09'! J ^ self filesystem: (FSWindowsFilesystem disk: 'J') path: FSPath root ! ! !FSReference class methodsFor: 'windows' stamp: 'cwp 11/20/2009 21:09'! K ^ self filesystem: (FSWindowsFilesystem disk: 'K') path: FSPath root ! ! !FSReference class methodsFor: 'windows' stamp: 'cwp 11/20/2009 21:09'! L ^ self filesystem: (FSWindowsFilesystem disk: 'L') path: FSPath root ! ! !FSReference class methodsFor: 'windows' stamp: 'cwp 11/20/2009 21:09'! M ^ self filesystem: (FSWindowsFilesystem disk: 'M') path: FSPath root ! ! !FSReference class methodsFor: 'windows' stamp: 'cwp 11/20/2009 21:09'! N ^ self filesystem: (FSWindowsFilesystem disk: 'N') path: FSPath root ! ! !FSReference class methodsFor: 'windows' stamp: 'cwp 11/20/2009 21:09'! O ^ self filesystem: (FSWindowsFilesystem disk: 'O') path: FSPath root ! ! !FSReference class methodsFor: 'windows' stamp: 'cwp 11/20/2009 21:09'! P ^ self filesystem: (FSWindowsFilesystem disk: 'P') path: FSPath root ! ! !FSReference class methodsFor: 'windows' stamp: 'cwp 11/20/2009 21:09'! Q ^ self filesystem: (FSWindowsFilesystem disk: 'Q') path: FSPath root ! ! !FSReference class methodsFor: 'windows' stamp: 'cwp 11/20/2009 21:09'! R ^ self filesystem: (FSWindowsFilesystem disk: 'R') path: FSPath root ! ! !FSReference class methodsFor: 'windows' stamp: 'cwp 11/20/2009 21:09'! S ^ self filesystem: (FSWindowsFilesystem disk: 'S') path: FSPath root ! ! !FSReference class methodsFor: 'windows' stamp: 'cwp 11/20/2009 21:09'! T ^ self filesystem: (FSWindowsFilesystem disk: 'T') path: FSPath root ! ! !FSReference class methodsFor: 'windows' stamp: 'cwp 11/20/2009 21:09'! U ^ self filesystem: (FSWindowsFilesystem disk: 'U') path: FSPath root ! ! !FSReference class methodsFor: 'windows' stamp: 'cwp 11/20/2009 21:09'! V ^ self filesystem: (FSWindowsFilesystem disk: 'V') path: FSPath root ! ! !FSReference class methodsFor: 'windows' stamp: 'cwp 11/20/2009 21:09'! W ^ self filesystem: (FSWindowsFilesystem disk: 'W') path: FSPath root ! ! !FSReference class methodsFor: 'windows' stamp: 'cwp 11/20/2009 21:09'! X ^ self filesystem: (FSWindowsFilesystem disk: 'X') path: FSPath root ! ! !FSReference class methodsFor: 'windows' stamp: 'cwp 11/20/2009 21:09'! Y ^ self filesystem: (FSWindowsFilesystem disk: 'Y') path: FSPath root ! ! !FSReference class methodsFor: 'windows' stamp: 'cwp 11/20/2009 21:09'! Z ^ self filesystem: (FSWindowsFilesystem disk: 'Z') path: FSPath root ! ! !FSReference class methodsFor: 'instance creation' stamp: 'cwp 1/13/2009 21:11'! filesystem: aFilesystem path: aPath ^ self new setFilesystem: aFilesystem path: aPath! ! !FSReference class methodsFor: 'cross platform' stamp: 'cwp 11/21/2009 12:19'! roots ^ Array streamContents: [:out | FSFilesystem putAllRootsOn: out]! ! !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: '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: 'cwp 11/16/2009 10:54'! allChildren ^ FSCollectVisitor breadthFirst: self collect: [:ea | ea reference]! ! !FSReference methodsFor: 'enumerating' stamp: 'cwp 11/16/2009 10:40'! allEntries ^ FSCollectVisitor breadthFirst: self! ! !FSReference methodsFor: 'converting' stamp: 'cwp 7/22/2009 08:33'! asAbsolute ^ 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: 'navigating' stamp: 'cwp 9/22/2009 09:03'! asResolvedBy: anObject ^ anObject resolveReference: self! ! !FSReference methodsFor: 'accessing' stamp: 'cwp 7/20/2009 09:17'! basename ^ path basename! ! !FSReference methodsFor: 'private' stamp: 'cwp 9/22/2009 09:56'! basicCopyTo: aReference | in out buffer | [in := filesystem readStreamOn: (filesystem resolve: path). in ifNil: [filesystem fileDoesNotExist: path]. aReference exists ifTrue: [aReference filesystem fileExists: path]. out := aReference writeStream. buffer := ByteArray new: 1024. [in atEnd] whileFalse: [buffer := in nextInto: buffer. out nextPutAll: buffer]] ensure: [in ifNotNil: [in close]. out ifNotNil: [out close]]! ! !FSReference methodsFor: 'navigating' stamp: 'cwp 11/15/2009 21:25'! children ^ filesystem childrenAt: path! ! !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: 'enumerating' stamp: 'cwp 1/26/2010 07:11'! copyAllTo: anObject FSCopyVisitor copy: self asAbsolute to: anObject resolve! ! !FSReference methodsFor: 'operations' stamp: 'cwp 11/15/2009 00:59'! copyTo: aReference self isDirectory ifTrue: [aReference ensureDirectory] ifFalse: [filesystem = aReference filesystem ifTrue: [filesystem copy: path to: aReference path] ifFalse: [self basicCopyTo: aReference]]! ! !FSReference methodsFor: 'operations' stamp: 'cwp 11/17/2009 21:05'! createDirectory filesystem createDirectory: path! ! !FSReference methodsFor: 'private' stamp: 'cwp 7/22/2009 06:56'! createHandle ^ filesystem createHandleFor: self! ! !FSReference methodsFor: 'operations' stamp: 'cwp 7/22/2009 07:42'! delete filesystem delete: path! ! !FSReference methodsFor: 'enumerating' stamp: 'cwp 11/15/2009 00:51'! deleteAll FSDeleteVisitor delete: self! ! !FSReference methodsFor: 'operations' stamp: 'cwp 1/13/2009 22:04'! ensureDirectory filesystem ensureDirectory: path ! ! !FSReference methodsFor: 'navigating' stamp: 'cwp 11/15/2009 22:25'! entries ^ filesystem entriesAt: path! ! !FSReference methodsFor: 'accessing' stamp: 'cwp 11/15/2009 21:34'! entry ^ filesystem entryAt: path! ! !FSReference methodsFor: 'testing' stamp: 'cwp 1/13/2009 20:52'! exists ^ filesystem exists: path! ! !FSReference methodsFor: 'streams' stamp: 'cwp 11/30/2009 23:58'! fileStreamDo: aBlock | stream | [stream := filesystem openFileStream: path writable: true. aBlock value: stream] ensure: [stream ifNotNil: [stream flush; close]] ! ! !FSReference methodsFor: 'accessing' stamp: 'cwp 7/18/2009 22:53'! filesystem ^ filesystem! ! !FSReference methodsFor: 'comparing' stamp: 'cwp 9/16/2009 23:54'! hash ^ path hash bitXor: filesystem hash! ! !FSReference methodsFor: 'testing' stamp: 'cwp 11/17/2009 22:02'! ifFile: fBlock ifDirectory: dBlock ifAbsent: aBlock ^ self isFile ifTrue: fBlock ifFalse: [self isDirectory ifTrue: dBlock ifFalse: aBlock]! ! !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' stamp: 'cwp 7/18/2009 22:53'! path ^ path! ! !FSReference methodsFor: 'printing' stamp: 'cwp 11/21/2009 11:31'! pathString ^ 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: 'cwp 10/15/2009 21:30'! readStreamDo: aBlock | stream | stream := self readStream. ^ [aBlock value: stream] ensure: [stream ifNotNil: [stream close]]! ! !FSReference methodsFor: 'streams' stamp: 'cwp 10/29/2009 10:02'! readStreamDo: doBlock ifAbsent: aBlock self isFile ifFalse: [^ aBlock value]. ^ self readStreamDo: doBlock! ! !FSReference methodsFor: 'streams' stamp: 'cwp 10/29/2009 11:11'! readStreamIfAbsent: aBlock self isFile ifFalse: [^ aBlock value]. ^ self readStream! ! !FSReference methodsFor: 'navigating' stamp: 'cwp 11/15/2009 00:26'! relativeTo: anObject ^ anObject makeRelative: self! ! !FSReference methodsFor: 'navigating' stamp: 'cwp 11/15/2009 00:27'! relativeToReference: aReference ^ path relativeTo: aReference path! ! !FSReference methodsFor: 'navigating' stamp: 'cwp 10/26/2009 02:02'! resolve ^ self! ! !FSReference methodsFor: 'navigating' stamp: 'cwp 10/26/2009 01:03'! resolve: anObject ^ anObject asResolvedBy: self! ! !FSReference methodsFor: 'navigating' stamp: 'cwp 9/22/2009 09:03'! resolvePath: anObject ^ self navigateWith: [path resolve: anObject]! ! !FSReference methodsFor: 'navigating' 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: 'navigating' 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: 'cwp 9/22/2009 20:33'! writeStreamDo: aBlock | stream | stream := self writeStream. [aBlock value: stream] ensure: [stream ifNotNil: [stream close]]! ! !FSReference methodsFor: 'streams' stamp: 'cwp 10/29/2009 09:55'! writeStreamDo: doBlock ifPresent: pBlock self isFile ifTrue: [^ pBlock value]. ^ self writeStreamDo: doBlock! ! !FSReference methodsFor: 'streams' stamp: 'cwp 10/29/2009 11:06'! writeStreamIfPresent: aBlock self isFile ifTrue: [^ aBlock value]. ^ self writeStream! ! Object subclass: #FSReleaseInfo instanceVariableNames: 'version' classVariableNames: 'Current' poolDictionaries: '' category: 'Filesystem-Release'! !FSReleaseInfo class methodsFor: 'as yet unclassified' stamp: 'cwp 11/20/2009 12:01'! current ^ Current! ! !FSReleaseInfo class methodsFor: 'as yet unclassified' stamp: 'cwp 11/20/2009 12:00'! currentVersion: anArray Current := self version: anArray! ! !FSReleaseInfo class methodsFor: 'as yet unclassified' stamp: 'cwp 11/20/2009 12:00'! version: anArray ^ self new initializeWithVersion: anArray! ! !FSReleaseInfo methodsFor: 'as yet unclassified' stamp: 'cwp 11/20/2009 12:00'! initializeWithVersion: anArray self initialize. version := anArray! ! !FSReleaseInfo methodsFor: 'as yet unclassified' stamp: 'cwp 11/20/2009 12:02'! version ^ version! ! Object subclass: #FSResolver instanceVariableNames: 'next' classVariableNames: '' poolDictionaries: '' category: 'Filesystem-Resolvers'! !FSResolver commentStamp: 'cwp 11/18/2009 11:52' prior: 0! I am an abstract super class for objects that can resolve origins into references. Such objects form a linked list, 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: 'as yet unclassified' 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: 'as yet unclassified' stamp: 'cwp 10/27/2009 11:01'! forCurrentPlatform | platformName | platformName := SmalltalkImage current platformName. ^ (self allSubclasses detect: [:ea | ea platformName = platformName]) new! ! !FSPlatformResolver class methodsFor: 'as yet unclassified' stamp: 'cwp 10/27/2009 10:58'! platformName ^ nil! ! !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: 'as yet unclassified' stamp: 'pls 12/18/2009 04:53'! platformName ^ 'unix'! ! !FSUnixResolver methodsFor: 'as yet unclassified' stamp: 'pls 12/18/2009 04:52'! desktop ^ self home / 'Desktop'! ! !FSUnixResolver methodsFor: 'as yet unclassified' stamp: 'pls 12/18/2009 04:53'! documents ^ self home / 'Documents'! ! !FSUnixResolver methodsFor: 'as yet unclassified' 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: 'as yet unclassified' 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 11/21/2009 11:30'! resolveString: aString | decoded | decoded := (FilePath pathName: aString isEncoded: true) asSqueakPathName. ^ FSDiskFilesystem current referenceFromString: 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: 'cwp 10/26/2009 20:04'! image ^ self resolveString: self primImagePath! ! !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: 'cwp 10/26/2009 20:05'! primVmDirectoryPath "Answer the full path name for the current image." self primitiveFailed! ! !FSSystemResolver methodsFor: 'resolving' stamp: 'cwp 10/26/2009 20:06'! supportedOrigins ^ #(image vmBinary vmDirectory)! ! !FSSystemResolver methodsFor: 'origins' stamp: 'cwp 10/26/2009 20:04'! vmBinary ^ self resolveString: (SmalltalkImage current getSystemAttribute: 0)! ! !FSSystemResolver methodsFor: 'origins' stamp: 'cwp 10/26/2009 20:05'! vmDirectory ^ self resolveString: self primVmDirectoryPath. ! ! 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 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: 'root guide 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: 'as yet unclassified' stamp: 'cwp 11/16/2009 10:33'! breadthFirst: aReference ^ self breadthFirst: aReference collect: [:entry | entry]! ! !FSCollectVisitor class methodsFor: 'as yet unclassified' stamp: 'cwp 11/16/2009 10:32'! breadthFirst: aReference collect: aBlock ^ (self collect: aBlock) breadthFirst: aReference! ! !FSCollectVisitor class methodsFor: 'as yet unclassified' stamp: 'cwp 11/16/2009 10:39'! collect: aBlock ^ self basicNew initializeWithBlock: aBlock! ! !FSCollectVisitor class methodsFor: 'as yet unclassified' stamp: 'cwp 11/16/2009 10:36'! postorder: aReference ^ self postorder: aReference collect: [:entry | entry]! ! !FSCollectVisitor class methodsFor: 'as yet unclassified' stamp: 'cwp 11/16/2009 10:35'! postorder: aReference collect: aBlock ^ (self collect: aBlock) postorder: aReference! ! !FSCollectVisitor class methodsFor: 'as yet unclassified' stamp: 'cwp 11/16/2009 10:35'! preorder: aReference ^ self preorder: aReference collect: [:entry | entry]! ! !FSCollectVisitor class methodsFor: 'as yet unclassified' 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: 'as yet unclassified' stamp: 'cwp 10/30/2009 13:44'! copy: source to: dest (self from: source to: dest) visit! ! !FSCopyVisitor class methodsFor: 'as yet unclassified' 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: 'as yet unclassified' stamp: 'cwp 11/17/2009 13:02'! delete: aReference ^ self new visit: aReference! ! !FSDeleteVisitor class methodsFor: 'as yet unclassified' stamp: 'cwp 11/15/2009 00:41'! root: aReference ^ self basicNew initializeWithRoot: 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! ! RWBinaryOrTextStream subclass: #FSFileStream instanceVariableNames: 'reference' 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: 'as yet unclassified' stamp: 'cwp 8/30/2009 18:28'! on: aCollection filesystem: aFilesystem path: aPath ^ self on: aCollection reference: (FSReference filesystem: aFilesystem path: aPath)! ! !FSFileStream class methodsFor: 'as yet unclassified' stamp: 'cwp 8/30/2009 18:28'! on: aCollection reference: aFileReference ^ (self on: aCollection) reference: aFileReference yourself! ! !FSFileStream methodsFor: 'private' stamp: 'cwp 8/30/2009 18:28'! on: aCollection super on: aCollection. readLimit := collection size.! ! !FSFileStream methodsFor: 'accessing' stamp: 'cwp 8/30/2009 18:14'! reference: aFileReference reference := aFileReference! ! 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 7/19/2009 22:21'! close reference filesystem truncateFile: reference path to: position. ! ! !FSMemoryFileStream methodsFor: 'private' stamp: 'cwp 7/19/2009 22:11'! growTo: anInteger collection := reference filesystem growFile: reference path to: anInteger. writeLimit := collection size. ! ! !FSMemoryFileStream methodsFor: 'private' stamp: 'cwp 7/19/2009 09:56'! pastEndPut: anObject | oldSize newSize | oldSize := collection size. newSize := oldSize + ((oldSize max: 20) min: 1000000). collection := reference filesystem growFile: reference path to: newSize. writeLimit := collection size. collection at: (position := position + 1) put: anObject. ^ anObject! ! TestCase subclass: #FSDirectoryEntryTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Filesystem-Tests'! !FSDirectoryEntryTest methodsFor: 'accessing' stamp: 'cwp 11/15/2009 22:04'! entry ^ FSDiskFilesystem imageFile entry! ! !FSDirectoryEntryTest methodsFor: 'tests' stamp: 'cwp 11/15/2009 22:09'! testCreationTime | creation | creation := self entry creation. self assert: creation class = DateAndTime. ! ! !FSDirectoryEntryTest methodsFor: 'tests' stamp: 'cwp 11/15/2009 22:10'! testIsDirectory | ref entry | ref := FSDiskFilesystem imageDirectory. entry := ref entry. self assert: entry isDirectory! ! !FSDirectoryEntryTest methodsFor: 'tests' stamp: 'cwp 11/15/2009 22:10'! testIsFile self assert: self entry isFile! ! !FSDirectoryEntryTest methodsFor: 'tests' stamp: 'cwp 11/15/2009 22:10'! testIsNotDirectory self deny: self entry isDirectory! ! !FSDirectoryEntryTest methodsFor: 'tests' stamp: 'cwp 11/15/2009 22:11'! testIsNotFile | ref | ref := FSDiskFilesystem imageDirectory. self deny: ref entry isFile! ! !FSDirectoryEntryTest methodsFor: 'tests' stamp: 'cwp 11/15/2009 22:09'! testModificationTime | modification | modification := self entry modification. self assert: modification class = DateAndTime. ! ! !FSDirectoryEntryTest methodsFor: 'tests' stamp: 'cwp 11/15/2009 20:00'! testReference | ref entry | ref := FSDiskFilesystem imageFile. 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 10/11/2009 21:45'! createFilesystem ^ FSDiskFilesystem currentClass 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 10/11/2009 20:13'! testIsDirectory self assert: (filesystem isDirectory: FSDiskFilesystem imageDirectory path)! ! !FSFilesystemTest class methodsFor: 'as yet unclassified' stamp: 'cwp 7/20/2009 08:56'! isAbstract ^ self name = #FSFilesystemTest! ! !FSFilesystemTest class methodsFor: 'as yet unclassified' 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 10/11/2009 22:15'! testChangeDirectory filesystem workingDirectory: (FSPath / 'plonk'). filesystem changeDirectory: 'griffle'. self assert: (filesystem workingDirectory printWithDelimiter: $/) = '/plonk/griffle'! ! !FSFilesystemTest methodsFor: 'tests' stamp: 'cwp 10/11/2009 22:14'! testChangeDirectoryString filesystem workingDirectory: (FSPath / 'plonk'). filesystem changeDirectory: 'griffle'. self assert: (filesystem workingDirectory printWithDelimiter: $/) = '/plonk/griffle'! ! !FSFilesystemTest methodsFor: 'tests' stamp: 'cwp 11/16/2009 00:12'! testChildrenAt | directory entries | directory := FSPath with: '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: FSReference). self assert: ea parent path = (filesystem resolve: directory). self assert: (#('griffle' 'bint' ) includes: ea basename) ]! ! !FSFilesystemTest methodsFor: 'tests' stamp: 'cwp 7/30/2009 23:49'! 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 10/10/2009 17:43'! testDirectory | path | path := FSPath with: '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: 'cwp 11/17/2009 19:57'! testEnsureDirectory | path | path := FSPath / 'plonk'. self delete: path. filesystem ensureDirectory: path. self assert: (filesystem isDirectory: path).! ! !FSFilesystemTest methodsFor: 'tests' stamp: 'cwp 11/17/2009 20:00'! 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: 'cwp 11/17/2009 19:58'! testEnsureDirectoryExists | path | path := FSPath / 'plonk'. self delete: path. filesystem createDirectory: path. self shouldnt: [filesystem ensureDirectory: path] raise: FSFilesystemError. ! ! !FSFilesystemTest methodsFor: 'tests' stamp: 'cwp 11/16/2009 00:13'! testEntriesAt | directory entries | directory := FSPath with: '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 10/10/2009 17:43'! testFile | path out | path := FSPath with: '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: 'lr 3/21/2010 11:59'! testFileNames | reference | #('test one' 'test with two' 'test-äöü' 'test.äöü') do: [ :each | reference := filesystem working / 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 working children anySatisfy: [ :ref | ref = reference ]) ] ensure: [ reference delete ] ]! ! !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 10/11/2009 22:14'! testSetRelativeWorkingDirectory self should: [filesystem workingDirectory: (FSPath with: 'plonk')] raise: Error ! ! !FSFilesystemTest methodsFor: 'tests' stamp: 'cwp 10/11/2009 22:13'! testSetWorkingDirectory filesystem workingDirectory: (FSPath / 'plonk'). self assert: (filesystem workingDirectory printWithDelimiter: $/) = '/plonk'.! ! !FSFilesystemTest methodsFor: 'tests' stamp: 'lr 2/14/2010 09:50'! testWorking self assert: filesystem working filesystem = filesystem. self assert: filesystem working path = filesystem workingDirectory! ! FSFilesystemTest subclass: #FSMemoryFilesystemTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Filesystem-Tests'! !FSMemoryFilesystemTest methodsFor: 'initialize-release' stamp: 'cwp 7/20/2009 07:29'! createFilesystem ^ FSMemoryFilesystem new! ! !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: 'lr 2/20/2010 11:14'! createFilesystem | ref | ref := FSMemoryFilesystem new referenceTo: 'fs.zip'. ^ (FSZipFilesystem atReference: ref) open; yourself! ! !FSZipFilesystemTest methodsFor: 'tests' stamp: 'lr 2/20/2010 23:14'! testOpenArchive | memory archive | memory := FSMemoryFilesystem new. 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 := FSZipFilesystem atReference: 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: 'lr 2/20/2010 22:45'! testWriteArchive | memory archive | memory := FSMemoryFilesystem new. archive := FSZipFilesystem atReference: 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 10/11/2009 22:25'! createFilesystem ^ FSDiskFilesystem currentClass createDefault! ! !FSHandleTest class methodsFor: 'as yet unclassified' stamp: 'cwp 7/26/2009 12:46'! isAbstract ^ self name = #FSHandleTest! ! !FSHandleTest class methodsFor: 'as yet unclassified' 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 7/26/2009 12:47'! createFilesystem ^ FSMemoryFilesystem new! ! TestCase subclass: #FSLocatorTest instanceVariableNames: 'locator' classVariableNames: '' poolDictionaries: '' category: 'Filesystem-Tests'! !FSLocatorTest methodsFor: 'compatibility tests' stamp: 'cwp 10/25/2009 10:29'! testAsAbsolute | locator | locator := FSLocator image. self assert: locator asAbsolute = locator! ! !FSLocatorTest methodsFor: 'compatibility tests' stamp: 'cwp 10/25/2009 11:07'! testBasename | locator | locator := FSLocator image / 'griffle'. self assert: locator basename = 'griffle'! ! !FSLocatorTest methodsFor: 'compatibility tests' stamp: 'cwp 10/25/2009 11:11'! testCommaAddsExtension | locator | locator := FSLocator image / 'griffle'. self assert: (locator , 'plonk') basename = 'griffle.plonk'! ! !FSLocatorTest methodsFor: 'compatibility tests' stamp: 'cwp 11/17/2009 23:59'! testCommaAddsExtensionAgain | locator | 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: 'cwp 10/25/2009 22:39'! 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 10/25/2009 22:12'! testFilesystem locator := FSLocator image. self assert: (locator filesystem isKindOf: FSDiskFilesystem)! ! !FSLocatorTest methodsFor: 'resolution tests' stamp: 'cwp 10/26/2009 13:46'! testImageDirectory | locator | locator := FSLocator image. self assert: locator resolve = FSDiskFilesystem imageFile! ! !FSLocatorTest methodsFor: 'compatibility tests' stamp: 'cwp 10/25/2009 10:28'! testIsAbsolute | locator | 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: 'cwp 10/25/2009 11:15'! testIsRelative | locator | locator := FSLocator image. self deny: locator isRelative! ! !FSLocatorTest methodsFor: 'compatibility tests' stamp: 'cwp 10/25/2009 11:24'! testIsRoot locator := FSLocator image. (locator resolve path size - 1) timesRepeat: [locator := locator / '..']. self assert: locator isRoot! ! !FSLocatorTest methodsFor: 'compatibility tests' stamp: 'cwp 10/26/2009 13:46'! testOriginBasename | locator | locator := FSLocator image. self assert: locator basename = (FSDiskFilesystem imageFile basename)! ! !FSLocatorTest methodsFor: 'compatibility tests' stamp: 'cwp 10/26/2009 13:45'! testParent locator := FSLocator image. self assert: locator parent resolve = FSDiskFilesystem imageDirectory! ! !FSLocatorTest methodsFor: 'resolution tests' stamp: 'cwp 10/25/2009 21:58'! testResolveAbsoluteReference | result reference | locator := FSLocator image / 'plonk'. reference := FSMemoryFilesystem new root / 'griffle'. result := locator resolve: reference.. self assert: result == reference! ! !FSLocatorTest methodsFor: 'resolution tests' stamp: 'cwp 10/27/2009 21:10'! 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 with: 'plonk') / 'griffle' / 'nurp')! ! !FSLocatorTest methodsFor: 'resolution tests' stamp: 'cwp 10/25/2009 21:43'! testResolvePath | result path | locator := FSLocator image / 'plonk'. result := locator resolve: (FSPath with: 'griffle'). path := (FSPath with: '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 10/25/2009 21:50'! testResolveRelativeReference | result reference | locator := FSLocator image / 'plonk'. reference := FSMemoryFilesystem new 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 10/25/2009 21:43'! testResolveString | result path | locator := FSLocator image / 'plonk'. result := locator resolve: 'griffle'. path := (FSPath with: 'plonk') / 'griffle'. self assert: result class= locator class. self assert: result origin = locator origin. self assert: result path = path.! ! !FSLocatorTest methodsFor: 'compatibility tests' stamp: 'cwp 10/25/2009 11:03'! testSlash | locator | locator := FSLocator image / 'griffle'. self assert: locator = (FSLocator image / 'griffle')! ! !FSLocatorTest methodsFor: 'compatibility tests' stamp: 'cwp 11/18/2009 00:00'! testWithExtensionAddsExtension | locator | locator := FSLocator image / 'griffle'. self assert: (locator withExtension: 'plonk') basename = 'griffle.plonk'! ! !FSLocatorTest methodsFor: 'compatibility tests' stamp: 'cwp 11/18/2009 00:02'! testWithExtensionReplacesExtension | locator | 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 10/10/2009 18:11'! testAsReference | path reference | path := FSPath with: 'plonk'. reference := path asReference. self assert: reference class = FSReference. self assert: reference path = path! ! !FSPathTest methodsFor: 'tests' stamp: 'cwp 10/10/2009 17:48'! testBasename | path | path := (FSPath with: 'plonk') / 'griffle'. self assert: path basename = 'griffle'! ! !FSPathTest methodsFor: 'tests' stamp: 'cwp 11/17/2009 13:03'! testCommaAddsExtension | path result | path := FSPath with: 'plonk' . result := path, 'griffle'. self assert: result asString = 'plonk.griffle'! ! !FSPathTest methodsFor: 'tests' stamp: 'cwp 11/17/2009 23:39'! testCommaAddsExtensionAgain | path result | path := FSPath with: '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 10/25/2009 22:48'! testContainsLocator | ancestor descendent | ancestor := FSDiskFilesystem imageDirectory path. descendent := FSLocator image / 'griffle'. self deny: (ancestor contains: descendent). self deny: (descendent contains: ancestor)! ! !FSPathTest methodsFor: 'tests' stamp: 'cwp 10/10/2009 17:49'! testEqual | a b | a := FSPath with: 'plonk'. b := FSPath with: '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 11/16/2009 09:36'! testIsChildOfReference | parent child | parent := FSPath / 'griffle'. child := (FSMemoryFilesystem new referenceTo: parent / 'nurb'). self deny: (child isChildOf: parent). self deny: (parent isChildOf: child)! ! !FSPathTest methodsFor: 'tests' stamp: 'cwp 10/10/2009 17:49'! testIsNotAbsolute self deny: (FSPath with: 'plonk') isAbsolute! ! !FSPathTest methodsFor: 'tests' stamp: 'cwp 10/10/2009 17:49'! testIsNotRelative self deny: (FSPath / 'plonk') isRelative! ! !FSPathTest methodsFor: 'tests' stamp: 'cwp 7/17/2009 05:23'! testIsNotRoot self deny: (FSPath root / 'plonk') isRoot! ! !FSPathTest methodsFor: 'tests' stamp: 'cwp 10/10/2009 17:50'! testIsRelative self assert: (FSPath with: 'plonk') isRelative! ! !FSPathTest methodsFor: 'tests' stamp: 'cwp 7/17/2009 05:23'! testIsRoot self assert: FSPath root isRoot! ! !FSPathTest methodsFor: 'tests' stamp: 'cwp 11/17/2009 13:03'! testParent | path parent | path := (FSPath with: 'plonk') / 'griffle'. parent := path parent. self assert: parent class = path class. self assert: parent asString = 'plonk'! ! !FSPathTest methodsFor: 'tests' stamp: 'cwp 10/25/2009 19:49'! testParentParent | path | path := (FSPath with: '..') parent. self assert: path size = 2. self assert: (path at: 1) = '..'. self assert: (path at: 2) = '..'.! ! !FSPathTest methodsFor: 'tests' stamp: 'cwp 10/10/2009 17:51'! testParentResolution | base relative absolute | base := FSPath / 'plonk' / 'pinto'. relative := FSPath parent / 'griffle' / 'zonk'. absolute := base resolve: relative. self assert: (absolute printWithDelimiter: $/) = '/plonk/griffle/zonk'! ! !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 10/10/2009 17:52'! testPrintWithDelimiter | path | path := (FSPath with: 'plonk') / 'griffle'. self assert: (path printWithDelimiter: $%) = 'plonk%griffle'! ! !FSPathTest methodsFor: 'tests' stamp: 'cwp 11/15/2009 00:20'! testRelativeTo | 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 10/11/2009 13:08'! testRelativeWithParent | path | path := FSPath withAll: #('..' 'foo'). self assert: (path printWithDelimiter: $/) = '../foo'! ! !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 10/25/2009 21:40'! testResolveString | path result | path := FSPath with: '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 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 10/10/2009 17:53'! testSimpleResolution | base relative absolute | base := FSPath / 'plonk'. relative := (FSPath with: 'griffle') / 'zonk'. absolute := base resolve: relative. self assert: (absolute printWithDelimiter: $/) = '/plonk/griffle/zonk'! ! !FSPathTest methodsFor: 'tests' stamp: 'cwp 10/10/2009 17:53'! testSlash | path actual | path := FSPath with: 'plonk'. actual := path / 'griffle'. self assert: actual class = FSPath. self assert: (actual printWithDelimiter: $/) = 'plonk/griffle'! ! !FSPathTest methodsFor: 'tests' stamp: 'cwp 10/10/2009 17:54'! testUnequalContent | a b | a := FSPath with: 'plonk'. b := FSPath with: 'griffle'. self deny: a = b.! ! !FSPathTest methodsFor: 'tests' stamp: 'cwp 10/10/2009 17:54'! testUnequalSize | a b | a := FSPath with: 'plonk'. b := (FSPath with: 'plonk') / 'griffle'. self deny: a = b.! ! !FSPathTest methodsFor: 'tests' stamp: 'cwp 11/17/2009 23:26'! testWithExtentionAddsExtension | path result | path := FSPath with: 'plonk'. result := path withExtension: 'griffle'. self assert: result asString = 'plonk.griffle'! ! !FSPathTest methodsFor: 'tests' stamp: 'cwp 11/17/2009 23:45'! testWithExtentionReplacesExtension | path result | path := FSPath with: 'plonk.griffle'. result := path withExtension: 'griffle'. self assert: result basename = 'plonk.griffle'! ! !FSPathTest methodsFor: 'tests' stamp: 'cwp 10/25/2009 19:44'! testWorkingDirectoryParent | path | path := FSPath empty 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 7/29/2009 22:40'! setUp filesystem := FSMemoryFilesystem new. ! ! !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: 'as yet unclassified' stamp: 'cwp 11/21/2009 11:56'! testCPath | ref | ref := FSReference C / 'WINDOWS'. self assert: (ref filesystem isKindOf: FSWindowsFilesystem). self assert: ref filesystem disk = 'C'. self assert: ref path = (FSPath / 'WINDOWS')! ! !FSReferenceCreationTest methodsFor: 'as yet unclassified' stamp: 'cwp 11/21/2009 12:17'! testRoots | roots | roots := FSReference roots. self deny: roots isEmpty. roots do: [:ref | self assert: ref class = FSReference. self assert: ref path isRoot]. self assert: (roots collect: [:ea | ea filesystem]) asSet size = roots size. ! ! 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 7/20/2009 09:06'! setUp filesystem := FSMemoryFilesystem new.! ! !FSReferenceTest methodsFor: 'tests' stamp: 'cwp 11/17/2009 16:44'! 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. 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 10/11/2009 22:38'! testAsAbsoluteConverted | ref absolute | ref := filesystem referenceTo: 'plonk'. absolute := ref asAbsolute. self assert: absolute isAbsolute. self assert: absolute asString = 'memory:/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: 'cwp 7/20/2009 09:17'! testBasename | ref | ref := filesystem referenceTo: 'plonk/griffle'. self assert: ref basename = 'griffle'! ! !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 10/26/2009 00:55'! testContainsLocator | ref | ref := FSDiskFilesystem imageDirectory parent. self assert: (ref contains: FSLocator image)! ! !FSReferenceTest methodsFor: 'tests' stamp: 'cwp 10/26/2009 00:53'! testContainsPath | ref | ref := filesystem referenceTo: (FSPath with: 'griffle'). self assert: (ref contains: (ref / 'nurp') path)! ! !FSReferenceTest methodsFor: 'tests' stamp: 'cwp 10/26/2009 00:50'! testContainsReference | ref | ref := filesystem referenceTo: (FSPath with: '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 10/26/2009 00:54'! testDoesntContainPath | ref | ref := filesystem referenceTo: (FSPath with: 'griffle'). self deny: (ref contains: (FSPath with: 'nurp'))! ! !FSReferenceTest methodsFor: 'tests' stamp: 'cwp 10/26/2009 00:52'! testDoesntContainReferenceFilesystem | ref other | ref := filesystem referenceTo: (FSPath with: 'griffle'). other := FSMemoryFilesystem new referenceTo: 'griffle/nurp'. self deny: (ref contains: other)! ! !FSReferenceTest methodsFor: 'tests' stamp: 'cwp 10/26/2009 00:52'! testDoesntContainReferencePath | ref other | ref := filesystem referenceTo: (FSPath with: 'griffle'). other := filesystem referenceTo: (FSPath with: 'nurp'). self deny: (ref contains: other)! ! !FSReferenceTest methodsFor: 'tests' stamp: 'cwp 11/16/2009 10:22'! 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: 'cwp 7/20/2009 09:21'! 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 7/20/2009 09:26'! testIsNotRoot self deny: (filesystem referenceTo: FSPath root / '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 7/20/2009 09:27'! testParent | ref parent | ref := (filesystem referenceTo: 'plonk/griffle'). parent := ref parent. self assert: parent class = ref class. self assert: parent asString = 'memory:plonk'! ! !FSReferenceTest methodsFor: 'tests' stamp: 'cwp 10/11/2009 16:55'! testParentResolutionWithAbsoluteReference | base relative absolute | base := (filesystem referenceTo: '/plonk/pinto'). relative := (FSMemoryFilesystem new referenceTo: '/griffle/zonk'). absolute := base resolve: relative. self assert: absolute filesystem == relative filesystem. self assert: (absolute path printWithDelimiter: $/) = '/griffle/zonk'! ! !FSReferenceTest methodsFor: 'tests' stamp: 'cwp 10/10/2009 17:55'! testParentResolutionWithPath | base relative absolute | base := filesystem referenceTo: (FSPath / 'plonk' / 'pinto'). relative := FSPath parent / 'griffle' / 'zonk'. absolute := base resolve: relative. self assert: absolute asString = 'memory:/plonk/griffle/zonk'! ! !FSReferenceTest methodsFor: 'tests' stamp: 'cwp 7/20/2009 09:31'! testParentResolutionWithReference | base relative absolute | base := (filesystem referenceTo: '/plonk/pinto'). relative := (filesystem referenceTo: '../griffle/zonk'). absolute := base resolve: relative. self assert: absolute asString = 'memory:/plonk/griffle/zonk'! ! !FSReferenceTest methodsFor: 'tests' stamp: 'cwp 10/11/2009 16:59'! testParentResolutionWithRemoteReference | base relative absolute | base := (filesystem referenceTo: '/plonk/pinto'). relative := (FSMemoryFilesystem new referenceTo: '../griffle/zonk'). absolute := base resolve: relative. self assert: absolute asString = 'memory:/plonk/griffle/zonk'! ! !FSReferenceTest methodsFor: 'tests' stamp: 'cwp 10/29/2009 09:45'! testReadStream | ref stream path | path := FSPath * 'plonk'. filesystem createFile: path. ref := filesystem referenceTo: path. [stream := ref readStream. self assert: (stream class = FSReadStream)] ensure: [stream ifNotNil: [stream close]]! ! !FSReferenceTest methodsFor: 'tests' stamp: 'cwp 10/29/2009 09:46'! testReadStreamDo | ref path s | path := FSPath * 'plonk'. filesystem 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' 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 10/29/2009 09:49'! testReadStreamDoifAbsent | ref path s | path := FSPath * 'plonk'. filesystem 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 10/29/2009 11:11'! testReadStreamIfAbsent | ref stream path | path := FSPath * 'plonk'. filesystem 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: '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 10/10/2009 18:06'! testSimpleResolution | base relative absolute | base := filesystem referenceTo: FSPath / 'plonk'. relative := (FSPath with: 'griffle') / 'zonk'. absolute := base resolve: relative. self assert: absolute asString = 'memory:/plonk/griffle/zonk'! ! !FSReferenceTest methodsFor: 'tests' stamp: 'cwp 7/20/2009 09:36'! testSlash | ref result | ref := filesystem referenceTo: 'plonk'. result := ref / 'griffle'. self assert: result class = FSReference. self assert: result asString = 'memory:plonk/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 11/17/2009 23:26'! testWithExtentionAddsExtension | ref result | ref := filesystem referenceTo: 'plonk'. result := ref withExtension: 'griffle'. self assert: result asString = 'memory:plonk.griffle'! ! !FSReferenceTest methodsFor: 'tests' stamp: 'cwp 11/17/2009 23:55'! testWithExtentionReplacesExtension | ref result | ref := filesystem referenceTo: 'plonk.griffle'. result := ref withExtension: 'nurp'. self assert: result asString = 'memory:plonk.nurp'! ! !FSReferenceTest methodsFor: 'tests' stamp: 'cwp 10/25/2009 19:56'! testWorkingDirectoryParent | wd | wd := filesystem referenceTo: FSPath new. 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 10/29/2009 11:03'! testWriteStreamDoExists | ref s path | path := FSPath * 'plonk'. filesystem 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 10/29/2009 09:57'! testWriteStreamDoifPresentNot | ref pass path | pass := false. path := FSPath * 'plonk'. filesystem createFile: path. ref := filesystem referenceTo: path. ref writeStreamDo: [:stream] ifPresent: [pass := true]. self assert: pass! ! !FSReferenceTest methodsFor: 'tests' stamp: 'cwp 10/29/2009 11:02'! testWriteStreamExists | ref stream path | path := FSPath * 'plonk'. filesystem 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 10/29/2009 11:08'! testWriteStreamifPresentExists | ref pass path | pass := false. path := FSPath * 'plonk'. filesystem 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 10/27/2009 11:11'! home ^ FSDiskFilesystem imageDirectory! ! !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: 'as yet unclassified' 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: 'cwp 10/26/2009 13:21'! testImage self assertOriginResolves: #image! ! !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 11/21/2009 11:30'! createDirectory: aString source createDirectory: (source pathFromString: aString)! ! !FSCopyVisitorTest methodsFor: 'running' stamp: 'cwp 11/21/2009 11:30'! createFile: aString source createFile: (source pathFromString: aString)! ! !FSCopyVisitorTest methodsFor: 'running' stamp: 'cwp 11/15/2009 00:32'! setUp source := FSMemoryFilesystem new. dest := FSMemoryFilesystem new. ! ! !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: 'as yet unclassified' 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 10/30/2009 13:30'! setUp visited := OrderedCollection new. filesystem := FSMemoryFilesystem new. 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 methodsFor: 'running' stamp: 'cwp 11/21/2009 11:30'! createDirectory: aString filesystem createDirectory: (filesystem pathFromString: aString)! ! !FSSingleTreeTest methodsFor: 'running' stamp: 'cwp 11/21/2009 11:30'! createFile: aString filesystem createFile: (filesystem pathFromString: aString)! ! !FSSingleTreeTest methodsFor: 'running' stamp: 'cwp 11/15/2009 07:42'! setUp super setUp. filesystem := FSMemoryFilesystem new. ! ! !FSTreeTest class methodsFor: 'as yet unclassified' stamp: 'cwp 10/30/2009 13:39'! isAbstract ^ self name = #FSTreeTest! ! !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 11/15/2009 21:33'! contents ^ filesystem nodeAt: FSPath / 'giffle' ifPresent: [:bytes | bytes] ifAbsent: [self signalFailure: 'No file!!']! ! !FSWriteStreamTest methodsFor: 'running' stamp: 'cwp 7/29/2009 21:57'! setUp filesystem := FSMemoryFilesystem new. 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: '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! ! 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: 'as yet unclassified' stamp: 'cwp 11/14/2009 23:32'! reference: aReference ^ self basicNew initializeWithReference: aReference! ! !FSFilesystemError class methodsFor: 'as yet unclassified' stamp: 'cwp 11/14/2009 23:31'! signalWith: aReference ^ (self reference: aReference) signal! ! !FSFilesystemError methodsFor: 'initialize-release' stamp: 'cwp 11/14/2009 23:32'! initializeWithReference: aReference reference := aReference! ! FSDiskFilesystem initialize! FSWindowsFilesystem initialize! FSFileHandle initialize! FSLocator initialize!