SystemOrganization addCategory: #'FileMan-Core'! !String methodsFor: '*fileman-converting' stamp: 'mu 6/19/2006 23:50'! / aString ^self asDirectoryEntry concat: aString! ! !String methodsFor: '*fileman-converting' stamp: 'mu 6/11/2006 19:07'! asAbsolutePathName "Not complete, but in most cases it is OK" | tokens curDir childPath | self isRelativePathName ifFalse: [^self]. self = '.' ifTrue: [^FileDirectory default pathName]. self = '..' ifTrue: [^FileDirectory default containingDirectory pathName]. tokens := self findTokens: '\:/'. curDir := FileDirectory default. tokens reverseDo: [:each | each = '..' ifTrue: [curDir := curDir containingDirectory] ]. tokens removeAllSuchThat: [:each | #('.' '..') includes: each ]. childPath := WriteStream on: ''. tokens do: [:each | childPath nextPutAll: each] separatedBy: [childPath nextPutAll: FileDirectory slash]. ^curDir pathName, FileDirectory slash, childPath contents! ! !String methodsFor: '*fileman-converting' stamp: 'mu 6/15/2006 21:48'! asDirectoryEntry ^FmDirectoryEntry pathName: self! ! !String methodsFor: '*fileman-converting' stamp: 'mu 6/11/2006 22:42'! asFileEntry self isRelativeMark ifTrue: [^self asDirectoryEntry]. ^FmFileEntry pathName: self! ! !String methodsFor: '*fileman-converting' stamp: 'mu 6/11/2006 22:38'! asPathComponents | tokens | self isRelativePathName ifTrue: [self error: 'relative form is invaild!!']. tokens := self findTokens: '\:/'. ^tokens! ! !String methodsFor: '*fileman-actions' stamp: 'mu 6/11/2006 22:12'! fileContents ^self asFileEntry fileContents! ! !String methodsFor: '*fileman-actions' stamp: 'mu 6/11/2006 22:19'! fileContents: aString self asFileEntry fileContents: aString. ^aString! ! !String methodsFor: '*fileman-testing' stamp: 'mu 8/16/2006 17:30'! isExistingDirectoryPathName | dir | dir := (FileDirectory on: self asAbsolutePathName). ^dir containingDirectory directoryExists: dir localName.! ! !String methodsFor: '*fileman-testing' stamp: 'mu 6/11/2006 19:29'! isExistingFilePathName | dir | dir _ (FileDirectory on: self asAbsolutePathName). ^dir containingDirectory fileExists: dir localName. ! ! !String methodsFor: '*fileman-testing' stamp: 'mu 6/11/2006 22:41'! isRelativeMark self = '.' ifTrue: [^true]. self = '..' ifTrue: [^true]. ^false! ! !String methodsFor: '*fileman-testing' stamp: 'mu 6/11/2006 22:42'! isRelativePathName | tokens | self isRelativeMark ifTrue: [^true]. tokens := self findTokens: '\:/' keep: '\:/'. ^#('.' '..') includes: tokens first! ! Object subclass: #FmFileEntry instanceVariableNames: 'drive pathComponents parent name fileSize creationTime modificationTime options' classVariableNames: '' poolDictionaries: '' category: 'FileMan-Core'! FmFileEntry subclass: #FmDirectoryEntry instanceVariableNames: 'children' classVariableNames: '' poolDictionaries: '' category: 'FileMan-Core'! !FmDirectoryEntry class methodsFor: 'instance creation' stamp: 'mu 6/15/2006 23:18'! default "FmDirectoryEntry default" ^FmDirectoryEntry on: FileDirectory default ! ! !FmDirectoryEntry class methodsFor: 'instance creation' stamp: 'mu 6/11/2006 13:55'! on: aFileDirectry "FmDirectory on: FileDirectory default" | inst | inst := self new. inst pathName: aFileDirectry pathName. ^ inst! ! !FmDirectoryEntry class methodsFor: 'instance creation' stamp: 'mu 6/11/2006 18:46'! parent "FmDirectory parent" ^self default parent ! ! !FmDirectoryEntry methodsFor: 'enumeration' stamp: 'mu 9/13/2006 19:45'! allChildrenDo: aBlock self childrenDo: [:child | aBlock value: child. child allChildrenDo: aBlock]! ! !FmDirectoryEntry methodsFor: 'enumeration' stamp: 'mu 9/13/2006 19:49'! allDirectoriesDo: aBlock self directoriesDo: [:child | aBlock value: child. child allDirectoriesDo: aBlock]! ! !FmDirectoryEntry methodsFor: 'enumeration' stamp: 'mu 9/13/2006 19:54'! allFilesDo: aBlock self childrenDo: [:child | child isFile ifTrue: [aBlock value: child] ifFalse: [child allFilesDo: aBlock]]! ! !FmDirectoryEntry methodsFor: 'archive operations' stamp: 'mu 9/21/2006 11:18'! archive ^self archiveMatching: [:ent | true]! ! !FmDirectoryEntry methodsFor: 'archive operations' stamp: 'mu 9/21/2006 11:20'! archiveMatching: aBlock "Get a zip archive object filtered with matching block" ^ZipArchive new addTree: self asFileDirectory assureExistence match: aBlock! ! !FmDirectoryEntry methodsFor: 'converting' stamp: 'mu 9/21/2006 10:21'! asDirectoryEntry ^self! ! !FmDirectoryEntry methodsFor: 'converting' stamp: 'mu 6/15/2006 23:25'! asFileDirectory "return lagacy FileDirectory" ^FileDirectory on: self pathName! ! !FmDirectoryEntry methodsFor: 'actions-directory' stamp: 'mu 6/15/2006 21:54'! assureExistence self asFileDirectory assureExistence. ^self! ! !FmDirectoryEntry methodsFor: 'dictionary-like' stamp: 'mu 6/18/2006 18:33'! at: localFileName ^self contentsOf: (self asFileDirectory readOnlyFileNamed: localFileName)! ! !FmDirectoryEntry methodsFor: 'dictionary-like' stamp: 'mu 7/27/2006 17:37'! at: localFileName ifAbsent: block ^ [self at: localFileName] on: FileDoesNotExistException do: [:ex | block value]! ! !FmDirectoryEntry methodsFor: 'dictionary-like' stamp: 'mu 6/18/2006 18:34'! at: localFileName put: contents self assureExistence. self setContentsOf: (self asFileDirectory forceNewFileNamed: localFileName) to: contents. ^contents! ! !FmDirectoryEntry methodsFor: 'dictionary-like' stamp: 'mu 8/10/2006 18:17'! binaryAt: localFileName ^self contentsOf: (self asFileDirectory readOnlyFileNamed: localFileName) binary! ! !FmDirectoryEntry methodsFor: 'dictionary-like' stamp: 'mu 8/10/2006 18:47'! binaryAt: localFileName ifAbsent: block ^ [self binaryAt: localFileName] on: FileDoesNotExistException do: [:ex | block value]! ! !FmDirectoryEntry methodsFor: 'dictionary-like' stamp: 'mu 9/21/2006 10:07'! binaryAt: localFileName put: contents ^self at: localFileName put: contents asByteArray! ! !FmDirectoryEntry methodsFor: 'accessing' stamp: 'mu 6/11/2006 17:37'! children children ifNil: [self initChildren]. ^children! ! !FmDirectoryEntry methodsFor: 'enumeration' stamp: 'mu 9/13/2006 19:43'! childrenDo: aBlock ^self children do: aBlock! ! !FmDirectoryEntry methodsFor: 'actions-directory' stamp: 'mu 9/21/2006 10:30'! copyTo: aDirectoryEntryOrString | toDir | toDir := aDirectoryEntryOrString asDirectoryEntry assureExistence. self filesDo: [:file | file copyTo: (toDir / file name)]. self directoriesDo: [:dir | toDir := toDir pathName / dir name. dir copyTo: toDir]! ! !FmDirectoryEntry methodsFor: 'actions-directory' stamp: 'mu 6/18/2006 18:29'! delete self parent asFileDirectory deleteDirectory: self name! ! !FmDirectoryEntry methodsFor: 'accessing' stamp: 'mu 6/11/2006 17:26'! directories ^self children select: [:each | each isFile not]! ! !FmDirectoryEntry methodsFor: 'enumeration' stamp: 'mu 9/13/2006 19:42'! directoriesDo: aBlock ^self directories do: aBlock! ! !FmDirectoryEntry methodsFor: 'enumeration' stamp: 'mu 6/18/2006 18:49'! directoriesMatches: selectionBlock ^self directories select: selectionBlock! ! !FmDirectoryEntry methodsFor: 'accessing' stamp: 'mu 6/20/2006 00:22'! directory ^self directories ifEmpty: [] ifNotEmpty: [:ds | ds first]! ! !FmDirectoryEntry methodsFor: 'testing' stamp: 'mu 8/10/2006 19:36'! exists ^FileDirectory default directoryExists: self pathName ! ! !FmDirectoryEntry methodsFor: 'accessing' stamp: 'mu 6/20/2006 00:22'! file ^self files ifEmpty: [] ifNotEmpty: [:fs | fs first]! ! !FmDirectoryEntry methodsFor: 'accessing' stamp: 'mu 6/11/2006 17:27'! files ^self children select: [:each | each isFile]! ! !FmDirectoryEntry methodsFor: 'enumeration' stamp: 'mu 9/13/2006 19:40'! filesDo: aBlock ^self files do: aBlock! ! !FmDirectoryEntry methodsFor: 'enumeration' stamp: 'mu 6/18/2006 18:48'! filesMatches: selectionBlock ^self files select: selectionBlock! ! !FmDirectoryEntry methodsFor: 'private' stamp: 'mu 9/13/2006 19:11'! initChildren | dir ents | dir := FileDirectory on: self pathName. self exists ifFalse: [^children _ #()]. ents := dir entries collect: [:each | FmFileEntry entry: each]. ents do: [:each | each parent: self]. children := ents. ^children! ! !FmDirectoryEntry methodsFor: 'testing' stamp: 'mu 6/11/2006 13:44'! isDirectory ^true! ! !FmDirectoryEntry methodsFor: 'testing' stamp: 'mu 6/11/2006 17:27'! isFile ^false! ! !FmDirectoryEntry methodsFor: 'dictionary-like' stamp: 'mu 7/27/2006 17:35'! keys ^self files! ! !FmDirectoryEntry methodsFor: 'enumeration' stamp: 'mu 6/18/2006 18:48'! latestFileMatches: selectionBlock | entries | entries _ self filesMatches: selectionBlock. entries ifEmpty: [^nil]. ^(entries sort: [:a :b | a modificationTime > b modificationTime]) first! ! !FmDirectoryEntry methodsFor: 'enumeration' stamp: 'mu 6/18/2006 18:48'! oldestFileMatches: selectionBlock | entries | entries _ self filesMatches: selectionBlock. entries ifEmpty: [^nil]. ^(entries sort: [:a :b | a modificationTime > b modificationTime]) last! ! !FmDirectoryEntry methodsFor: 'actions-directory' stamp: 'mu 10/12/2006 20:07'! recursiveDelete self exists ifTrue: [self asFileDirectory recursiveDelete]! ! !FmDirectoryEntry methodsFor: 'initialize-release' stamp: 'mu 9/13/2006 19:37'! refresh super refresh. children _ nil! ! !FmDirectoryEntry methodsFor: 'dictionary-like' stamp: 'mu 6/18/2006 18:34'! removeKey: localFileName ^self asFileDirectory deleteFileNamed: localFileName! ! !FmDirectoryEntry methodsFor: 'dictionary-like' stamp: 'mu 9/20/2006 18:10'! removeKey: localFileName ifAbsent: failBlock ^self asFileDirectory deleteFileNamed: localFileName ifAbsent: failBlock! ! !FmDirectoryEntry methodsFor: 'archive operations' stamp: 'mu 9/22/2006 10:56'! writeArchiveTo: aFileEntryOrString Utilities informUserDuring: [:bar | bar value: ('Creating archive of {1} to: {2}' translated format: {self pathName. aFileEntryOrString}). self archive writeTo: aFileEntryOrString asFileEntry writeStream]! ! !FmFileEntry class methodsFor: 'instance creation' stamp: 'mu 6/15/2006 21:49'! entry: aFileEntry | inst | inst := aFileEntry isDirectory ifTrue: [FmDirectoryEntry new] ifFalse: [FmFileEntry new]. inst name: aFileEntry name. inst initValuesFrom: aFileEntry. ^inst! ! !FmFileEntry class methodsFor: 'examples' stamp: 'mu 6/20/2006 00:24'! example1 "FmFileEntry example1" "- Create subDirectory named: 'subDir'. - Put a new file named: 'file1'. - Write contents 'Hello!! to that file'" "Traditional way" | subDir str | subDir := FileDirectory default directoryNamed: 'subDir'. subDir assureExistence. [str := subDir newFileNamed: 'file1'. str nextPutAll: 'Hello!!'] ensure: [str close]. "FileMan" './subDir' asDirectoryEntry at: 'file2' put: 'Hello!!'! ! !FmFileEntry class methodsFor: 'examples' stamp: 'mu 6/20/2006 00:24'! example2 "FmFileEntry example2" "FileMan's path representation is portable" ('./subDir' / 'aaa\bbb' / 'ccc' / 'ddd\eee' / 'fff:ggg') at: 'test1' put: 'Hello2!!'.! ! !FmFileEntry class methodsFor: 'examples' stamp: 'mu 6/20/2006 00:24'! example3 "FmFileEntry example3" "Remove 'test1' file created exapmle2" ('./subDir' / 'aaa\bbb' / 'ccc' / 'ddd\eee' / 'fff:ggg') removeKey: 'test1'. "Recursive delete" './subDir' asDirectoryEntry recursiveDelete! ! !FmFileEntry class methodsFor: 'examples' stamp: 'mu 6/20/2006 00:24'! example4 "FmFileEntry example4" "Collect sm directory package names" | packageNames | packageNames := './sm/cache/packages' asDirectoryEntry directories collect: [:each | each directory file name]. packageNames inspect! ! !FmFileEntry class methodsFor: 'examples' stamp: 'mu 9/21/2006 09:57'! example5 "FmFileEntry example5" "Write test1 file and copy it to test2 in the parent directory" './test1' fileContents: 'This is a test'. './test1' asFileEntry copyTo: '../test2'. '../test2' fileContents inspect! ! !FmFileEntry class methodsFor: 'examples' stamp: 'mu 10/5/2006 19:58'! example6 "FmFileEntry example6" "test1 file contents will be written to test2 using reverse filter. test2 file contents will be written to test3 again using reverse filter." | reverseFilter | 'test1.txt' fileContents: 'This is a test'. reverseFilter _ [:in :out | out nextPutAll: (in upToEnd reverse)]. ('test1.txt' asFileEntry pipe: reverseFilter to: 'test2.txt') pipe: reverseFilter to: 'test3.txt'. (#('test1.txt' 'test2.txt' 'test3.txt') collect: [:each | each fileContents]) inspect ! ! !FmFileEntry class methodsFor: 'examples' stamp: 'mu 10/26/2006 18:38'! example7 "FmFileEntry example7" "Useful example: copy latest mcz files to releaseDir (for preparing SAR)" | releaseDir dir fileNames | releaseDir := './releasePkg' asDirectoryEntry. releaseDir keys isEmpty ifFalse: [releaseDir recursiveDelete]. dir := './package-cache' asDirectoryEntry. fileNames := (dir keys collect: [:each | each name upTo: $.] thenSelect: [:each | each notEmpty]). (fileNames collect: [:eachName | dir latestFileMatches: [:each | each name beginsWith: eachName]]) do: [:eachEnt | eachEnt copyTo: releaseDir]! ! !FmFileEntry class methodsFor: 'class initialization' stamp: 'mu 9/13/2006 19:34'! initialize "FmFileEntry initialize" Smalltalk addToStartUpList: self! ! !FmFileEntry class methodsFor: 'instance creation' stamp: 'mu 6/11/2006 17:42'! pathComponents: comps | inst | inst := self new. inst pathComponents: comps. ^inst ! ! !FmFileEntry class methodsFor: 'instance creation' stamp: 'mu 10/26/2006 19:21'! pathComponents: comps drive: driveString | inst | inst := self new. inst pathComponents: comps detectDrive: false. inst drive: driveString. ^inst ! ! !FmFileEntry class methodsFor: 'instance creation' stamp: 'mu 6/11/2006 22:21'! pathName: aString | inst | inst := self new. inst pathName: aString. ^inst ! ! !FmFileEntry class methodsFor: 'starting up' stamp: 'mu 9/13/2006 19:35'! startUp self allSubInstancesDo: [:each | each refresh]! ! !FmFileEntry methodsFor: 'actions-path' stamp: 'mu 6/19/2006 23:29'! , pathString ^self concat: pathString! ! !FmFileEntry methodsFor: 'actions-path' stamp: 'mu 6/19/2006 23:52'! / pathString ^self, pathString! ! !FmFileEntry methodsFor: 'comparing' stamp: 'mu 6/11/2006 18:01'! = aFileEntry self class = aFileEntry class ifFalse: [^false]. ^self pathComponents = aFileEntry pathComponents! ! !FmFileEntry methodsFor: 'enumeration' stamp: 'mu 9/13/2006 19:47'! allChildrenDo: aBlock "do nothing"! ! !FmFileEntry methodsFor: 'enumeration' stamp: 'mu 9/13/2006 19:50'! allDirectoriesDo: aBlock "do nothing"! ! !FmFileEntry methodsFor: 'enumeration' stamp: 'mu 9/13/2006 19:51'! allFilesDo: aBlock "do nothing"! ! !FmFileEntry methodsFor: 'actions-file' stamp: 'mu 9/27/2006 20:21'! appendContents: aStringOrBytes self appendStreamContents: [:str | aStringOrBytes isString ifFalse: [str binary]. str nextPutAll: aStringOrBytes]! ! !FmFileEntry methodsFor: 'accessing-stream' stamp: 'mu 9/27/2006 20:09'! appendStream self exists ifFalse: [^ self writeStream]. ^ (FileStream fileNamed: self pathName) setToEnd! ! !FmFileEntry methodsFor: 'accessing-stream' stamp: 'mu 9/27/2006 20:15'! appendStreamContents: blockWithArg | stream | stream := self appendStream. [blockWithArg value: stream] ensure: [stream ifNotNilDo: [:s | s close]]! ! !FmFileEntry methodsFor: 'archive operations' stamp: 'mu 9/21/2006 12:03'! archive "Get a zip archive object from thic file entry (need to be an existing compressed file)" ^ZipArchive new readFrom: self pathName! ! !FmFileEntry methodsFor: 'converting' stamp: 'mu 6/19/2006 23:43'! asDirectoryEntry ^ FmDirectoryEntry pathComponents: self pathComponents drive: self drive! ! !FmFileEntry methodsFor: 'converting' stamp: 'mu 9/21/2006 10:20'! asFileEntry ^self! ! !FmFileEntry methodsFor: 'enumeration' stamp: 'mu 10/12/2006 20:18'! assureExistence self exists ifTrue: [^self]. self parent assureExistence. self writeStream close! ! !FmFileEntry methodsFor: 'dictionary-like' stamp: 'mu 7/30/2006 22:45'! at: localFileName ^self asDirectoryEntry at: localFileName asString ifAbsent:[]! ! !FmFileEntry methodsFor: 'dictionary-like' stamp: 'mu 7/27/2006 17:33'! at: localFileName ifAbsent: block ^self asDirectoryEntry at: localFileName asString ifAbsent: block! ! !FmFileEntry methodsFor: 'dictionary-like' stamp: 'mu 7/19/2006 16:59'! at: localFileName put: contents ^self asDirectoryEntry at: localFileName asString put: contents! ! !FmFileEntry methodsFor: 'accessing' stamp: 'mu 6/11/2006 17:49'! basicPathComponents: aCollection pathComponents := aCollection! ! !FmFileEntry methodsFor: 'dictionary-like' stamp: 'mu 8/10/2006 18:47'! binaryAt: localFileName ^self asDirectoryEntry binaryAt: localFileName asString ifAbsent:[]! ! !FmFileEntry methodsFor: 'dictionary-like' stamp: 'mu 8/10/2006 18:47'! binaryAt: localFileName ifAbsent: block ^self asDirectoryEntry binaryAt: localFileName asString ifAbsent: block! ! !FmFileEntry methodsFor: 'actions-file' stamp: 'mu 8/10/2006 18:13'! binaryContents ^self contentsOf: self readStream binary! ! !FmFileEntry methodsFor: 'actions-file' stamp: 'mu 8/10/2006 18:15'! binaryContents: aByteArray self setContentsOf: self writeStream binary to: aByteArray ! ! !FmFileEntry methodsFor: 'accessing' stamp: 'mu 8/1/2006 19:24'! children ^self asDirectoryEntry children! ! !FmFileEntry methodsFor: 'enumeration' stamp: 'mu 9/13/2006 19:57'! childrenDo: aBlock ^self asDirectoryEntry childrenDo: aBlock! ! !FmFileEntry methodsFor: 'archive operations' stamp: 'mu 9/21/2006 11:14'! compress "simple gzipping" self readStream compressFile! ! !FmFileEntry methodsFor: 'actions-path' stamp: 'mu 7/30/2006 14:06'! concat: pathString ^self concatPathComponents: pathString asString asPathComponents.! ! !FmFileEntry methodsFor: 'actions-path' stamp: 'mu 6/19/2006 23:40'! concatPathComponents: components ^ FmFileEntry pathComponents: (self pathComponents copy addAll: components; yourself) drive: self drive! ! !FmFileEntry methodsFor: 'private' stamp: 'mu 8/10/2006 18:21'! contentsOf: aStream | str conts | [str := aStream. conts := str contents] ensure: [str ifNotNilDo: [:s | s close]]. ^ conts! ! !FmFileEntry methodsFor: 'actions-file' stamp: 'mu 10/12/2006 20:22'! copyTo: aFileEntryOrString | targetEntry | targetEntry := aFileEntryOrString asFileEntry. targetEntry isDirectory ifTrue: [targetEntry := targetEntry / self name]. FileDirectory default copyFile: self readStream binary toFile: targetEntry writeStream binary! ! !FmFileEntry methodsFor: 'accessing' stamp: 'mu 6/11/2006 18:19'! creationTime creationTime ifNil: [self initValuesFromParent]. ^creationTime! ! !FmFileEntry methodsFor: 'accessing' stamp: 'mu 6/11/2006 14:03'! creationTime: value creationTime _ value! ! !FmFileEntry methodsFor: 'actions-file' stamp: 'mu 6/18/2006 18:35'! delete self parent asFileDirectory deleteFileNamed: self name! ! !FmFileEntry methodsFor: 'accessing' stamp: 'mu 8/1/2006 19:21'! directories ^self asDirectoryEntry directories! ! !FmFileEntry methodsFor: 'enumeration' stamp: 'mu 9/13/2006 19:57'! directoriesDo: aBlock ^self asDirectoryEntry directoriesDo: aBlock! ! !FmFileEntry methodsFor: 'enumeration' stamp: 'mu 8/9/2006 13:55'! directoriesMatches: selectionBlock ^self asDirectoryEntry directoriesMatches: selectionBlock! ! !FmFileEntry methodsFor: 'accessing' stamp: 'mu 8/1/2006 19:23'! directory ^self asDirectoryEntry directory! ! !FmFileEntry methodsFor: 'accessing' stamp: 'mu 10/26/2006 10:08'! drive self onUnix ifTrue: [^drive _ nil]. drive ifNil: [drive _ self parent ifNotNil: [self parent drive]]. ^drive! ! !FmFileEntry methodsFor: 'accessing' stamp: 'mu 6/11/2006 13:26'! drive: aString drive _ aString! ! !FmFileEntry methodsFor: 'private' stamp: 'mu 6/18/2006 11:29'! ensureParent self pathComponents size <= 1 ifTrue: [^ nil]. parent := FmDirectoryEntry pathComponents: (self pathComponents copyFrom: 1 to: self pathComponents size - 1) drive: self drive. ^ parent! ! !FmFileEntry methodsFor: 'testing' stamp: 'mu 8/10/2006 19:30'! exists ^FileDirectory default fileExists: self pathName ! ! !FmFileEntry methodsFor: 'accessing-file name' stamp: 'mu 6/19/2006 23:27'! extension ^self nameVersionExtension last! ! !FmFileEntry methodsFor: 'archive operations' stamp: 'mu 9/22/2006 10:49'! extractAllTo: aFileEntryOrString | dir | dir := aFileEntryOrString asDirectoryEntry asFileDirectory. Utilities informUserDuring: [:bar | self archive extractAllTo: dir informing: bar overwrite: true]! ! !FmFileEntry methodsFor: 'accessing' stamp: 'mu 8/1/2006 19:23'! file ^self asDirectoryEntry file! ! !FmFileEntry methodsFor: 'actions-file' stamp: 'mu 8/10/2006 18:12'! fileContents "Default is text mode" ^self textContents! ! !FmFileEntry methodsFor: 'actions-file' stamp: 'mu 8/10/2006 18:15'! fileContents: aStringOrBytes aStringOrBytes isString ifTrue: [self textContents: aStringOrBytes] ifFalse: [self binaryContents: aStringOrBytes]! ! !FmFileEntry methodsFor: 'accessing' stamp: 'mu 6/11/2006 18:19'! fileSize fileSize ifNil: [self initValuesFromParent]. ^fileSize! ! !FmFileEntry methodsFor: 'accessing' stamp: 'mu 6/11/2006 14:07'! fileSize: value fileSize _ value! ! !FmFileEntry methodsFor: 'accessing' stamp: 'mu 8/1/2006 19:22'! files ^self asDirectoryEntry files! ! !FmFileEntry methodsFor: 'enumeration' stamp: 'mu 9/13/2006 19:57'! filesDo: aBlock ^self asDirectoryEntry filesDo: aBlock! ! !FmFileEntry methodsFor: 'enumeration' stamp: 'mu 8/9/2006 13:54'! filesMatches: selectionBlock ^self asDirectoryEntry filesMatches: selectionBlock! ! !FmFileEntry methodsFor: 'private' stamp: 'mu 6/18/2006 11:45'! getContentsOf: aStream | str conts | [str := aStream. conts := str contents] ensure: [str ifNotNilDo: [:s | s close]]. ^ conts! ! !FmFileEntry methodsFor: 'private' stamp: 'mu 6/11/2006 18:18'! initValuesFrom: otherEntry otherEntry ifNil: [^self]. self creationTime: otherEntry creationTime. self modificationTime: otherEntry modificationTime. self fileSize: otherEntry fileSize. ! ! !FmFileEntry methodsFor: 'private' stamp: 'mu 6/11/2006 18:18'! initValuesFromParent | targets target | self ensureParent. self parent ifNil: [^self]. targets := self isDirectory ifTrue: [self parent directories] ifFalse: [self parent files]. target := targets detect: [:each | each = self] ifNone:[]. self initValuesFrom: target. ! ! !FmFileEntry methodsFor: 'testing' stamp: 'mu 6/11/2006 13:45'! isDirectory ^false! ! !FmFileEntry methodsFor: 'private' stamp: 'mu 10/26/2006 19:26'! isDriveName: firstToken self onWindows ifTrue: [^ firstToken size = 2 and: [(firstToken endsWith: ':') and: [firstToken first asCharacter isDriveLetter]]]. self onMac ifTrue: [^FileDirectory root directoryNames includes: firstToken]. ^false! ! !FmFileEntry methodsFor: 'testing' stamp: 'mu 6/11/2006 13:44'! isFile ^true! ! !FmFileEntry methodsFor: 'testing' stamp: 'mu 6/11/2006 17:27'! isFileEntry ^true! ! !FmFileEntry methodsFor: 'dictionary-like' stamp: 'mu 7/27/2006 17:35'! keys ^self asDirectoryEntry keys! ! !FmFileEntry methodsFor: 'enumeration' stamp: 'mu 8/9/2006 13:55'! latestFileMatches: selectionBlock ^self asDirectoryEntry latestFileMatches: selectionBlock! ! !FmFileEntry methodsFor: 'accessing' stamp: 'mu 6/11/2006 18:19'! modificationTime modificationTime ifNil: [self initValuesFromParent]. ^modificationTime! ! !FmFileEntry methodsFor: 'accessing' stamp: 'mu 6/11/2006 14:03'! modificationTime: value modificationTime := value! ! !FmFileEntry methodsFor: 'accessing' stamp: 'mu 6/11/2006 13:35'! name ^name! ! !FmFileEntry methodsFor: 'accessing' stamp: 'mu 6/18/2006 22:05'! name: aString name := aString. self pathComponents ifNotEmpty: [self pathComponents at: self pathComponents size put: name]! ! !FmFileEntry methodsFor: 'accessing-file name' stamp: 'mu 6/19/2006 23:26'! nameVersionExtension ^FileDirectory new splitNameVersionExtensionFor: self name! ! !FmFileEntry methodsFor: 'enumeration' stamp: 'mu 8/9/2006 13:55'! oldestFileMatches: selectionBlock ^self asDirectoryEntry oldestFileMatches: selectionBlock! ! !FmFileEntry methodsFor: 'testing' stamp: 'mu 10/26/2006 10:07'! onMac ^FileDirectory pathNameDelimiter = $:! ! !FmFileEntry methodsFor: 'testing' stamp: 'mu 10/26/2006 10:07'! onUnix ^FileDirectory pathNameDelimiter = $/! ! !FmFileEntry methodsFor: 'testing' stamp: 'mu 10/26/2006 10:07'! onWindows ^FileDirectory pathNameDelimiter = $\! ! !FmFileEntry methodsFor: 'accessing' stamp: 'mu 6/19/2006 23:21'! options ^options! ! !FmFileEntry methodsFor: 'accessing' stamp: 'mu 6/19/2006 23:21'! options: aCollection options _ aCollection! ! !FmFileEntry methodsFor: 'accessing' stamp: 'mu 6/11/2006 17:41'! parent parent ifNil: [parent _ self ensureParent]. ^parent! ! !FmFileEntry methodsFor: 'accessing' stamp: 'mu 6/11/2006 14:16'! parent: aFmDirectory parent := aFmDirectory. self pathName: aFmDirectory pathName, FileDirectory slash, self name! ! !FmFileEntry methodsFor: 'accessing' stamp: 'mu 6/11/2006 13:16'! pathComponents pathComponents ifNil: [pathComponents _ OrderedCollection new]. ^pathComponents! ! !FmFileEntry methodsFor: 'initialize-release' stamp: 'mu 10/26/2006 19:20'! pathComponents: aCollection self pathComponents: aCollection detectDrive: true! ! !FmFileEntry methodsFor: 'initialize-release' stamp: 'mu 10/26/2006 19:19'! pathComponents: aCollection detectDrive: detectDrive | tokens firstToken | tokens := aCollection. (detectDrive and: [self isDriveName: (firstToken := aCollection first)]) ifTrue: [self drive: firstToken. self basicPathComponents: (tokens copyFrom: 2 to: tokens size)] ifFalse: [self basicPathComponents: tokens]. pathComponents ifNotEmpty: [self name: pathComponents last]! ! !FmFileEntry methodsFor: 'accessing' stamp: 'mu 6/11/2006 13:57'! pathName | str | str _ '' writeStream. self printPathOn: str. ^str contents! ! !FmFileEntry methodsFor: 'initialize-release' stamp: 'mu 10/28/2006 19:28'! pathName: aString | path tokens | path := aString asAbsolutePathName. tokens := path findTokens: FileDirectory slash. tokens ifEmpty: [^ nil]. (self onUnix and: [path beginsWith: '/']) ifTrue: [^self pathComponents: tokens]. (tokens size = 1) ifTrue: [ ^self pathName: (FmDirectoryEntry default concat: aString) pathName]. self pathComponents: tokens! ! !FmFileEntry methodsFor: 'actions-pipe' stamp: 'mu 10/5/2006 19:47'! pipe: filterBlock to: aFileEntryOrString | nextEntry inStream outStream | nextEntry _ aFileEntryOrString asFileEntry. [inStream := self readStream. outStream := nextEntry writeStream. filterBlock value: inStream value: outStream] ensure: [inStream close. outStream close]. ^nextEntry ! ! !FmFileEntry methodsFor: 'actions-pipe' stamp: 'mu 10/5/2006 19:41'! pipeRepeat: filterBlock to: aFileEntryOrString ^self pipeRepeat: filterBlock while: [:in :out | in atEnd not] to: aFileEntryOrString ! ! !FmFileEntry methodsFor: 'actions-pipe' stamp: 'mu 10/5/2006 19:48'! pipeRepeat: filterBlock while: terminateBlock to: aFileEntryOrString | nextEntry inStream outStream | nextEntry _ aFileEntryOrString asFileEntry. [inStream := self readStream. outStream := nextEntry writeStream. [terminateBlock value: inStream value: outStream] whileTrue: [filterBlock value: inStream value: outStream]] ensure: [inStream close. outStream close]. ^nextEntry! ! !FmFileEntry methodsFor: 'printing' stamp: 'mu 6/11/2006 13:40'! printOn: aStream self drive ifNotNilDo: [:d | aStream nextPutAll: d]. aStream nextPutAll: FileDirectory slash. self pathComponents do: [:each | aStream nextPutAll: each] separatedBy: [aStream nextPutAll: FileDirectory slash]! ! !FmFileEntry methodsFor: 'printing' stamp: 'mu 6/11/2006 13:56'! printPathOn: aStream self drive ifNotNilDo: [:d | aStream nextPutAll: d]. aStream nextPutAll: FileDirectory slash. self pathComponents do: [:each | aStream nextPutAll: each] separatedBy: [aStream nextPutAll: FileDirectory slash]! ! !FmFileEntry methodsFor: 'accessing-stream' stamp: 'mu 6/15/2006 23:23'! readStream ^ [FileStream readOnlyFileNamed: self pathName] on: FileDoesNotExistException do: [:ex | self assureExistence. ex retry]! ! !FmFileEntry methodsFor: 'accessing-stream' stamp: 'mu 10/2/2006 23:52'! readStreamContents: blockWithArg | stream conts | stream := self readStream. [conts := blockWithArg value: stream] ensure: [stream ifNotNilDo: [:s | s close]]. ^ conts! ! !FmFileEntry methodsFor: 'initialize-release' stamp: 'mu 9/13/2006 19:36'! refresh fileSize _ creationTime _ modificationTime _ nil! ! !FmFileEntry methodsFor: 'dictionary-like' stamp: 'mu 7/19/2006 17:00'! removeKey: localFileName ^self asDirectoryEntry removeKey: localFileName asString! ! !FmFileEntry methodsFor: 'dictionary-like' stamp: 'mu 9/20/2006 18:10'! removeKey: localFileName ifAbsent: failBlock ^self asDirectoryEntry removeKey: localFileName asString ifAbsent: failBlock! ! !FmFileEntry methodsFor: 'actions-file' stamp: 'mu 6/18/2006 21:59'! rename: newName self parent asFileDirectory rename: self name toBe: newName. self name: newName! ! !FmFileEntry methodsFor: 'private' stamp: 'mu 9/13/2006 20:54'! setContentsOf: aStream to: aStringOrBytes | str | [str := aStream. aStringOrBytes isString ifFalse: [str binary]. str nextPutAll: aStringOrBytes] ensure: [str ifNotNilDo: [:s | s close]]! ! !FmFileEntry methodsFor: 'actions-file' stamp: 'mu 8/10/2006 18:12'! textContents ^self contentsOf: self readStream! ! !FmFileEntry methodsFor: 'actions-file' stamp: 'mu 8/10/2006 18:13'! textContents: aString self setContentsOf: self writeStream to: aString ! ! !FmFileEntry methodsFor: 'accessing-file name' stamp: 'mu 6/19/2006 23:28'! version ^self nameVersionExtension second! ! !FmFileEntry methodsFor: 'accessing-stream' stamp: 'mu 10/12/2006 20:26'! writeStream self parent exists ifFalse: [self parent assureExistence]. ^FileStream forceNewFileNamed: self pathName! ! !FmFileEntry methodsFor: 'accessing-stream' stamp: 'mu 6/11/2006 22:15'! writeStreamConfirming ^FileStream newFileNamed: self pathName! ! !FmFileEntry methodsFor: 'accessing-stream' stamp: 'mu 9/27/2006 20:15'! writeStreamContents: blockWithArg | stream | stream := self writeStream. [blockWithArg value: stream] ensure: [stream ifNotNilDo: [:s | s close]]! ! !Object methodsFor: '*fileman-testing' stamp: 'mu 10/12/2006 20:20'! asFileEntry ^self asString asFileEntry! ! !Object methodsFor: '*fileman-testing' stamp: 'mu 6/11/2006 17:28'! isFileEntry ^false! ! !Character methodsFor: '*fileman-testing' stamp: 'mu 6/11/2006 13:24'! isDriveLetter ^'ABCDEFGHIJKLMNOPQRSTUVWXYZ' includes: self ! ! FmFileEntry initialize!