Packages March 2009

packages@lists.squeakfoundation.org

1 participants
117 discussions

Rio: File-Kernel-test.17.mcz
by squeak-dev-noreply＠lists.squeakfoundation.org 02 Mar '09

02 Mar '09

A new version of File-Kernel was added to project Rio: http://www.squeaksource.com/Rio/File-Kernel-test.17.mcz ==================== Summary ==================== Name: File-Kernel-test.17 Author: test Time: 2 March 2009, 9:18:04 pm UUID: 28e3d5e0-8417-cf45-85f9-c453793fb444 Ancestors: File-Kernel-kph.16 all but one of the non ftp tests working on windows. =============== Diff against File-Kernel-kph.16 =============== Item was changed: ----- Method: FileExecutive>>touch: (in category 'as yet unclassified') ----- touch: aRio + aRio writer use: [:r | ]! - aRio writer close! Item was changed: ----- Method: FileKernel>>pathJoin: (in category 'private') ----- pathJoin: morePath + value := executive importValue: ( + (executive isRoot: value) + ifTrue: [ value , morePath asString ] + ifFalse: [ value isEmpty + ifTrue: [ morePath asString ] + ifFalse: [ self value, executive class pathDelimiter, morePath asString ]]) - value := (executive isRoot: value) - ifTrue: [ value , morePath asString ] - ifFalse: [ value isEmpty - ifTrue: [ morePath asString ] - ifFalse: [ self value, executive class pathDelimiter, morePath asString ]] !

1 0

Rio: File-Test-kph.11.mcz
by squeak-dev-noreply＠lists.squeakfoundation.org 02 Mar '09

02 Mar '09

A new version of File-Test was added to project Rio: http://www.squeaksource.com/Rio/File-Test-kph.11.mcz ==================== Summary ==================== Name: File-Test-kph.11 Author: kph Time: 2 March 2009, 8:36 pm UUID: bde1bc6b-0769-11de-a0af-000a95edb42a Ancestors: File-Test-kph.10 all test pass on unix =============== Diff against File-Test-kph.10 =============== Item was added: + ----- Method: FileVirtualTestFSUnix class>>classForPath: (in category 'as yet unclassified') ----- + classForPath: aPath + + | voted | + (voted := super classForPath: aPath) = self superclass ifTrue: [ self ] ifFalse: [ voted ] + ! Item was changed: ----- Method: FileTest>>testLinearRelativeToNot (in category 'tests') ----- testLinearRelativeToNot + newFile := (file := '/a/b/c' asFile) linearRelativeTo: '/no/relation/at/all' asFile. - newFile := (file := '/a/b/c/d/e/f' asFile full) linearRelativeTo: '/no/relation/at/all' asFile. self assert: (newFile = file).! Item was added: + ----- Method: FileModeTests>>testRenamingModeFullNameSetMinor (in category 'renaming mode') ----- + testRenamingModeFullNameSetMinor + + | new | + file := self useTestDir / self hello. + + file touch. + + self assert: (file isFile). + + new := file rename full: '_test2_/testing/goodbye.text'. + + self assert: (new isFile). + self deny: (file isFile).! Item was changed: ----- Method: FileVirtualFSDosFileTest>>testLinearRelativeTo (in category 'tests') ----- testLinearRelativeTo + " + self debug: #testLinearRelativeTo + " + + | original | + original := 'E:\hello\this\is\a\world\apart\from\here.txt' asFile. + file := original linearRelativeTo: 'E:\hello\this' asFile. - file := fileClass new: 'E:\hello\this\is\a\world\apart\from\here.txt'. - - file := file linearRelativeTo: (fileClass new: 'E:\hello\this'). self assert: (file = 'is\a\world\apart\from\here.txt'). + + self assert: file full = original. + ! - - ! Item was added: + ----- Method: FileVirtualTestFSDos class>>classForPath: (in category 'as yet unclassified') ----- + classForPath: aPath + + | voted | + (voted := super classForPath: aPath) = self superclass ifTrue: [ self ] ifFalse: [ voted ] + ! Item was added: + ----- Method: FileVirtualFSUnixKernelTest>>testThisImage (in category 'tests') ----- + testThisImage + + | i | + + i := fileClass thisImage. + self assert: (i = '/home/user/bob/squeak/this.image'). + + ^ i ! Item was added: + ----- Method: FileModeTests>>testRenamingModeFileNameSet (in category 'renaming mode') ----- + testRenamingModeFileNameSet + + | new | + file := self useTestDir / self hello. + + file touch. + + self assert: (file isFile). + + new := file rename fileName: 'goodbye.text'. + + self deny: (file isFile). + self assert: (new isFile).! Item was changed: ----- Method: FileVirtualFSCommonTest>>setUp (in category 'tests-string behaviour') ----- setUp + self localExecutiveClass initializeLocal. - self localExecutive initializeDefault! Item was changed: ----- Method: FileVirtualFSUnixFileTest>>testLinearRelativeTo (in category 'tests') ----- testLinearRelativeTo + + | original | + original := '/hello/this/is/a/world/apart/from/here.txt' asFile. + file := original linearRelativeTo: '/hello/this' asFile. - - file := (File new: '/hello/this/is/a/world/apart/from/here.txt') - linearRelativeTo: (File new: '/hello/this'). + self assert: (file = 'is/a/world/apart/from/here.txt'). + + self assert: file full = original.! - self assert: (file = 'is/a/world/apart/from/here.txt').! Item was added: + ----- Method: FileVirtualFSUnixKernelTest>>testParent (in category 'tests') ----- + testParent + + "note that the parent of root is the file system 'executive' " + + self assert: ((fileClass new: '/a/b') parent = '/a'). + self assert: ((fileClass new: '/a') parent = '/'). + self assert: ((fileClass new: '/') parent class = FileVirtualTestFSUnix).! Item was added: + ----- Method: FileVirtualFSUnixKernelTest>>testInstantiateRoot (in category 'tests') ----- + testInstantiateRoot + + file := fileClass new: '/'. + self assert: (file = '/'). + self assert: (file isRoot). + ! Item was changed: ----- Method: FileModeTests>>testRenamingModeFullNameSet (in category 'renaming mode') ----- testRenamingModeFullNameSet + | | + file := self useTestDir / self hello. - rio := self useTestDir / self hello. - - rio touch. + file touch. + + self assert: (file isFile). - self assert: (rio isFile). + self should: [ file rename full: '/tmp/_test_/goodbye.text' ] raise: Error + ! - newRio := rio rename fileName: 'goodbye.text'. - - self deny: (rio isFile). - self assert: (newRio isFile).! Item was changed: ----- Method: FileTest>>testLinearRelativeTo (in category 'tests') ----- testLinearRelativeTo + | original | + original := '/hello/this/is/a/world/apart/from/here.txt' asFile. + file := original linearRelativeTo: '/hello/this' asFile. - - file := '/hello/this/is/a/world/apart/from/here.txt' asFile linearRelativeTo: '/hello/this' asFile. + self assert: (file = 'is/a/world/apart/from/here.txt'). + + self assert: file full = original.! - self assert: (file = 'is/a/world/apart/from/here.txt').! Item was added: + ----- Method: FileVirtualFSDosKernelTest>>testVerifyHomeDirectory (in category 'tests') ----- + testVerifyHomeDirectory + + file := self currentFileSystem homeDirectory. + + self assert: (file class = dirClass). + self assert: file asString = 'D:\User\Bob\Squeak'.! Item was added: + ----- Method: FileVirtualFSUnixKernelTest>>testVerifyHomeDirectory (in category 'tests') ----- + testVerifyHomeDirectory + + file := self currentFileSystem homeDirectory. + + self assert: (file class = dirClass). + self assert: file asString = '/home/user/bob/squeak'.! Item was added: + ----- Method: FileVirtualFSDosKernelTest>>testSplitToPathAndName (in category 'tests') ----- + testSplitToPathAndName + + (self fileClass new: 'E:\a\b') splitToPathAndName: [ :p :n | self assert: (p = 'E:\a'). self assert: (n = 'b') ]. + (self fileClass new: 'E:\a') splitToPathAndName: [ :p :n | self assert: (p = 'E:\'). self assert: (n = 'a') ]. + (self fileClass new: 'a\b') splitToPathAndName: [ :p :n | self assert: (p = 'a'). self assert: (n = 'b') ]. + (self fileClass new: 'a') splitToPathAndName: [ :p :n | self assert: (p = ''). self assert: (n = 'a') ]. + ! Item was added: + ----- Method: FileVirtualFSUnixKernelTest>>testSplitToPathAndName (in category 'tests') ----- + testSplitToPathAndName + + (self fileClass new: 'a/b') splitToPathAndName: [ :p :n | self assert: (p = 'a'). self assert: (n = 'b') ]. + (self fileClass new: 'a') splitToPathAndName: [ :p :n | self assert: (p = ''). self assert: (n = 'a') ]. + (self fileClass new: '/a/b') splitToPathAndName: [ :p :n | self assert: (p = '/a'). self assert: (n = 'b') ]. + (self fileClass new: '/a') splitToPathAndName: [ :p :n | self assert: (p = '/'). self assert: (n = 'a') ].! Item was removed: - ----- Method: FileVirtualFSUnixKernelTest>>root (in category 'tests') ----- - root - - ! Item was removed: - ----- Method: FileVirtualFSUnixKernelTest>>thisImage (in category 'tests') ----- - thisImage - - | i | - - i := fileClass thisImage. - self assert: (i = '/home/user/bob/squeak/this.image'). - - ^ i ! Item was removed: - ----- Method: FileVirtualFSUnixKernelTest>>parent (in category 'tests') ----- - parent - - "note that the parent of root is the file system 'executive' " - - self assert: ((fileClass new: '/a/b') parent = '/a'). - self assert: ((fileClass new: '/a') parent = '/'). - self assert: ((fileClass new: '/') parent class = FileVirtualTestFSUnix).! Item was removed: - ----- Method: FileVirtualFSUnixKernelTest>>verifyDefaultDirectory (in category 'tests') ----- - verifyDefaultDirectory - - file := self currentFileSystem defaultDirectory. - - self assert: (file class = dirClass). - self assert: file asString = '/home/user/bob/squeak'.! Item was removed: - ----- Method: FileVirtualFSCommonTest class>>allStandardTests (in category 'as yet unclassified') ----- - allStandardTests - - ^ super allStandardTests , (self suiteWithMethodCategoryMatching: 'tests*') - ! Item was removed: - ----- Method: FileVirtualTestFSUnix>>checkVoted: (in category 'as yet unclassified') ----- - checkVoted: voted - - "alternative local executives may override this to rig the voting" - - "we rig the voting so we win if the winner is the executive we are spoofing" - - ^ voted = self class superclass ifTrue: [ ^ self class ] ifFalse: [ voted ] - ! Item was removed: - ----- Method: FileVirtualTestFSDos>>checkVoted: (in category 'as yet unclassified') ----- - checkVoted: voted - - "alternative local executives may override this to rig the voting" - - "we rig the voting so we win if the winner is the executive we are spoofing" - - ^ voted = self class superclass ifTrue: [ ^ self class ] ifFalse: [ voted ] - ! Item was removed: - ----- Method: FileVirtualFSUnixKernelTest>>instantiateRoot (in category 'tests') ----- - instantiateRoot - - file := fileClass new: '/'. - self assert: (file = '/'). - self assert: (file isRoot). - ! Item was removed: - ----- Method: FileVirtualFSDosKernelTest>>testVerifyDefaultDirectory (in category 'tests') ----- - testVerifyDefaultDirectory - - file := self currentFileSystem defaultDirectory. - - self assert: (file class = dirClass). - self assert: file asString = 'D:\User\Bob\Squeak'.!

1 0

Rio: File-Kernel-kph.16.mcz
by squeak-dev-noreply＠lists.squeakfoundation.org 02 Mar '09

02 Mar '09

A new version of File-Kernel was added to project Rio: http://www.squeaksource.com/Rio/File-Kernel-kph.16.mcz ==================== Summary ==================== Name: File-Kernel-kph.16 Author: kph Time: 2 March 2009, 8:35:40 pm UUID: b22180ec-0769-11de-a0af-000a95edb42a Ancestors: File-Kernel-kph.15 all test pass on unix =============== Diff against File-Kernel-kph.15 =============== Item was changed: ----- Method: FileLocalExecutive>>copyLocalFile:toLocalFile: (in category 'as yet unclassified') ----- copyLocalFile: aFile toLocalFile: bFile + + File + ospIfWin:[ :os | os waitForCommand: 'cp "', aFile asVmPathName, '" "', bFile asVmPathName, '"'. ] + ifUnix: [ :os | os waitForCommand: 'cp "', aFile asVmPathName, '" "', bFile asVmPathName, '"'. ] + ifNone: [ - - | | - - self class OSProcessOrNil ifNotNilDo: [ :osp | - - osp waitForCommand: 'cp "', aFile asVmPathName, '" "', bFile asVmPathName, '"'. ^ aFile - - ]. - - (self primCopyFile: aFile asVmPathName to: bFile asVmPathName) = #failed ifTrue: [ ^ aFile copyTo: bFile ]. + (self primCopyFile: aFile asVmPathName to: bFile asVmPathName) = #failed + ifTrue: [ aFile copyTo: bFile ]. + + ] - ^ aFile - ! Item was added: + ----- Method: FileExecutive>>homeDirectory (in category 'as yet unclassified') ----- + homeDirectory + + | | + ^ self class dirClass executive: self value: home ! Item was changed: ----- Method: FileExecutive>>newOfClass:from: (in category 'instanciation') ----- newOfClass: aClass from: aPathString "this is the core instanciation method" | voted new | "take a vote, if anyone wants to be the executive for this path" voted := self class classForPath: aPathString. + + new := (voted isNil "or: [ voted = self class ]") + ifFalse: [ voted makeNew: aClass from: aPathString ] + ifTrue: [ aClass executive: self value: (self importValue: aPathString) ]. - - voted := self checkVoted: voted. - - new := voted ifNotNil: [ voted makeNew: aClass from: aPathString ] - ifNil: [ aClass executive: self value: aPathString ]. ^ new lineEndConvention: self lineEndConvention; yourself! Item was changed: FileExecutive subclass: #FileLocalExecutive + instanceVariableNames: 'rootString root' + classVariableNames: 'Local Dynamic' - instanceVariableNames: 'rootString root defaultDirectory' - classVariableNames: 'Dynamic Fixed Local' poolDictionaries: '' category: 'File-Kernel'! !FileLocalExecutive commentStamp: 'kph 4/17/2007 19:25' prior: 0! Introducing the idea that Rio's exist in the context of their 'physical container', we have the RioLocalFileSystem as the primary container which provides the file system interface, also known as the 'executive'. On unix there is one executive for the whole system. On dos there is one executive per volume. This approach also supports the notion of files within archives and files on remote servers. On startup, having a formal model of the host filesystem allows us to keep a current and previous instance introducing the possibility for migrating Rio's on startup when the image has been moved. For example C:/ could be replaced with /mnt/hda1 thus attempting to make images properly portable. (experimental idea) ! Item was changed: ----- Method: FileLocalDosExecutive>>importValue: (in category 'as yet unclassified') ----- importValue: aPath + | dosPath | + aPath isEmpty ifTrue: [ ^ '' ]. + + dosPath := aPath copy replaceAll: $/ with: $\. + + (dosPath size = 2 and: [ dosPath last = $: ]) ifTrue: [ dosPath := dosPath , self class pathDelimiter ]. + + (self isRoot: dosPath) ifTrue: [ ^ dosPath ]. + + ^ dosPath! - ^ super importValue: (aPath copy replaceAll: $/ with: $\).! Item was added: + ----- Method: FileLocalDosExecutive class>>initialize (in category 'as yet unclassified') ----- + initialize + + volumes := nil! Item was changed: ----- Method: FileLocalExecutive>>rename:to: (in category 'executive actions') ----- rename: aRio to: bRio + (self retryWithGC:[ self primRename: aRio asVmPathName to: bRio asVmPathName ] until:[:result| result notNil] forFileNamed: aRio) ~~ nil ifTrue:[ aRio statIsNowInvalid. ^ bRio ]. + aRio exists ifFalse:[ self error:'Attempt to rename a non-existent file:' , aRio]. - aRio exists ifFalse:[ ^ self error:'Attempt to rename a non-existent file:' , aRio]. + bRio exists ifTrue:[ self error: 'Failed to rename, ', bRio,' already exists.' ]. + + self error: 'Failed to rename' , aRio, ' to ', bRio! - bRio exists ifTrue:[ ^self error: 'Failed to rename, ', bRio,' already exists.' ].! Item was changed: ----- Method: FileLocalExecutive class>>initialize (in category 'class initialization') ----- initialize Smalltalk addToStartUpList: self after: Delay. + self initializeLocal. + Dynamic := nil.! - Local := self newForThisPlatform initializeDefault. - ! Item was changed: ----- Method: FileLocalExecutive>>setRootString: (in category 'executive actions') ----- setRootString: aString + rootString := aString. ! Item was changed: ----- Method: FileKernel>>linearRelativeTo: (in category 'accessing') ----- linearRelativeTo: aDirectoryOrFile + | tmp exec | + self full = aDirectoryOrFile full ifTrue: [ + + exec := self executive copy setHome: self value. + + ^ exec class dirClass executive: exec value:'' ]. + + tmp := (self parent linearRelativeTo: aDirectoryOrFile) pathJoin: self fileName. - | tmp | - self full = aDirectoryOrFile full ifTrue: [ ^ Directory new: '' ]. - - tmp := (self parent linearRelativeTo: aDirectoryOrFile) / self fileName. ^tmp ! Item was changed: ----- Method: FileLocalDosExecutive class>>executiveForVolume: (in category 'as yet unclassified') ----- executiveForVolume: theRequestedRoot | requestedRoot | requestedRoot := theRequestedRoot. + requestedRoot = nil ifTrue: [ requestedRoot := 'C:', self pathDelimiter ]. - requestedRoot = nil ifTrue: [ requestedRoot := 'C:/' ]. ^ self volumes detect: [ :i | i isRoot: requestedRoot ] ifNone: [ self volumes add: (self basicNew setRootString: requestedRoot; setDefault: nil; yourself) ]! Item was added: + ----- Method: FileExecutive>>setHome: (in category 'as yet unclassified') ----- + setHome: d + + "store home directory as a string, otherwise storeOn: is recursive" + + home := d asString! Item was changed: ----- Method: FileLocalDosExecutive>>fullFor: (in category 'as yet unclassified') ----- fullFor: aRio "the absolute path of this rio (with the current volume drive prepended), or if relative + combine with #homeDirectory to obtain the full path" - combine with #defaultDirectory to obtain the full path" + aRio value isEmpty ifTrue: [ ^ self homeDirectory ]. - aRio value isEmpty ifTrue: [ ^ self defaultDirectory ]. (self isFull: aRio) ifTrue: [ ^ aRio ]. "if we are an absolute path, prepend the volume" aRio value first = self pathDelimiterChar ifTrue: [ ^ aRio newFrom: (self drive, aRio value) ]. + ^ aRio newFrom: (home, self class pathDelimiter, aRio value) + ! - ^ aRio newFrom: (self defaultDirectory value, self pathDelimiter, aRio value)! Item was changed: Object subclass: #FileExecutive + instanceVariableNames: 'home' - instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'File-Kernel'! Item was changed: + ----- Method: FileExecutive>>pathDelimiterChar (in category 'case-sensitivity') ----- - ----- Method: FileExecutive>>pathDelimiterChar (in category 'as yet unclassified') ----- pathDelimiterChar + + ^ self class pathDelimiter first! - - ^ $/ - ! Item was added: + ----- Method: FileLocalExecutive>>home (in category 'accessing') ----- + home + + ^ self class dirClass executive: self value: home ! Item was changed: ----- Method: FileLocalDosExecutive class>>makeNew:from: (in category 'as yet unclassified') ----- makeNew: aClass from: path | rioDrive exec str | str := (path beginsWith: 'file:///') ifTrue: [ (path allButFirst: 8) unescapePercents ] ifFalse: [ path ]. rioDrive := nil. (str size > 1) ifTrue: [ (str second = $:) ifTrue: [ rioDrive := (str first: 2) , self pathDelimiter ]. ]. exec := self executiveForVolume: rioDrive. ^ aClass executive: exec value: str! Item was changed: ----- Method: FileLocalDosExecutive>>initializeDefault (in category 'as yet unclassified') ----- initializeDefault + - self setRootString: (self primImagePath first: 3); setDefault: self getDefaultDirectory. self class volumes add: self.! Item was added: + ----- Method: FileLocalDosExecutive>>isFull: (in category 'accessing') ----- + isFull: aFileOrDirectory + + | path | + path := aFileOrDirectory value. + + ^ ((path size >= 3) and: [ $: = (path at: 2) ]) and: [ self pathDelimiterChar = (path at: 3) ] + + ! Item was changed: ----- Method: FileLocalDosExecutive>>isRoot: (in category 'as yet unclassified') ----- isRoot: aRioOrString + ^ aRioOrString value size = self rootString size and: [self isFull: aRioOrString ] - aRioOrString value size = self rootString size ifTrue: [ ^ super isRoot: aRioOrString ]. + ! - ^ (aRioOrString value, self pathDelimiter) = self rootString! Item was changed: ----- Method: FileExecutive>>importValue: (in category 'executive actions') ----- importValue: path path isEmpty ifTrue: [ ^ '' ]. + (self isRoot: path) ifTrue: [ ^ path ]. - (self isRoot: path) ifTrue: [ ^ self rootString ]. + (path last = self pathDelimiterChar) ifTrue: [ ^ path allButLast ]. - (path last = self pathDelimiter first) ifTrue: [ ^ path allButLast ]. ^path! Item was changed: ----- Method: FileLocalExecutive>>initializeDefault (in category 'executive actions') ----- initializeDefault + self setRootString: self class pathDelimiter; - self setRootString: self pathDelimiter; setDefault: self getDefaultDirectory! Item was changed: ----- Method: FileLocalExecutive>>linearRelativeTo: (in category 'executive actions') ----- linearRelativeTo: aDirectory self ~= aDirectory executive ifTrue: [ ^ self errorMustBeInSameFileSystem: aDirectory ]. + ^ self class dirClass executive: self value: self rootString! - ^ self root! Item was changed: ----- Method: FileKernel>>parent (in category 'accessing') ----- parent "note that the parent of root is the file system 'executive' " + ^ self isRoot ifTrue: [ executive ] + ifFalse: [ executive class dirClass executive: executive value: self full path] - ^self isRoot ifTrue: [ executive ] - ifFalse: [ executive class dirClass executive: executive value: self full path ] ! Item was changed: ----- Method: FileLocalExecutive>>setDefault: (in category 'executive actions') ----- setDefault: d + "store home directory as a string, otherwise storeOn: is recursive" - "store default directory as a string, otherwise storeOn: is recursive" + home := d asString! - defaultDirectory := d asString! Item was changed: ----- Method: FileLocalDosExecutive class>>pathDelimiter (in category 'as yet unclassified') ----- pathDelimiter ^ '\' ! Item was changed: ----- Method: FileLocalExecutive>>pretendDuring: (in category 'pretending') ----- pretendDuring: aBlock "In rare circumstances we want to handle a list of dos paths while in fact we are a unix box, lets say we were compiling a script to be remotely distributed to DOS box. This technique also helps with testing various filesystems. We pop the notification in to the Dynamic slot, the only call it knows is #currentExecutive Within the block, a call to currentExecutive, signals, and returns self. We 'ensure:' everything returns to normal when the block exits, if you need to do this manually, then FileNotification will return fixedExecutive currentExecutive by default. " | tmp | [ tmp := Dynamic. Dynamic := FileNotification. + + [ aBlock value ] on: FileNotification do: [ :ex | ex executive: self ] - - [ aBlock value ] on: FileNotification do: [ :ex | ex executive: self ] ] ensure: [ Dynamic := tmp ]! Item was changed: ----- Method: FileKernel>>splitToPathAndName: (in category 'as yet unclassified') ----- splitToPathAndName: pathAndNameBlock "Take the path and convert it to the path name of a directory and a local file name within that directory. FileName must be of the form: <dirPath><delimiter><localName>, where <dirPath><delimiter> is optional. The <dirPath> part may contain delimiters." + | i dirName localName fullName max | - | i dirName localName fullName | fullName := self value. i := fullName lastIndexOf: executive pathDelimiterChar. + "((i <= executive rootString size) and: [ executive isFull: self ]) + ifTrue: [ ^ pathAndNameBlock value: (fullName copyFrom: 1 to: i) value: fullName ]." + i == 0 ifTrue: [ ^ pathAndNameBlock value: '' value: fullName ]. + max := (executive isFull: self) ifTrue: [ executive rootString size ] ifFalse: [1]. + dirName := fullName copyFrom: 1 to: (i - 1 max: max). - dirName := fullName copyFrom: 1 to: (i - 1 max: 1). localName := fullName copyFrom: i + 1 to: fullName size. ^ pathAndNameBlock value: dirName value: localName! Item was added: + ----- Method: FileLocalExecutive class>>initializeLocal (in category 'class initialization') ----- + initializeLocal + + Local := self newForThisPlatform initializeDefault. + ! Item was changed: ----- Method: FileExecutive>>cleanDir: (in category 'case-sensitivity') ----- cleanDir: aDir + File + ospIfWin:[ :os | os waitForCommand: 'cd ', aDir,' && del \s *.*'. ] + ifUnix: [ :os | os waitForCommand: 'cd ', aDir,'; rm -rf *' ] + ifNone: [ aDir all delete ] + ! - (self class OSProcessOrNil ifNil: [ ^ aDir all delete ]) waitForCommand: 'cd ', aDir,'; rm -rf *'.! Item was changed: ----- Method: FileKernel>>pathJoin: (in category 'private') ----- pathJoin: morePath value := (executive isRoot: value) ifTrue: [ value , morePath asString ] ifFalse: [ value isEmpty ifTrue: [ morePath asString ] + ifFalse: [ self value, executive class pathDelimiter, morePath asString ]] - ifFalse: [ self value, '/', morePath asString ]] ! Item was changed: ----- Method: FileExecutive>>fullFor: (in category 'as yet unclassified') ----- fullFor: aFileOrDirectory "the absolute path of this rio, or if relative + combine with #homeDirectory to obtain the full path" - combine with #defaultDirectory to obtain the full path" + aFileOrDirectory value isEmpty ifTrue: [ ^ self homeDirectory ]. - aFileOrDirectory value isEmpty ifTrue: [ ^ self defaultDirectory ]. (self isFull: aFileOrDirectory) ifTrue: [ ^ aFileOrDirectory ]. + ^ aFileOrDirectory newFrom: (home, self class pathDelimiter, aFileOrDirectory value)! - ^ aFileOrDirectory newFrom: (self defaultDirectory value, self pathDelimiter, aFileOrDirectory value)! Item was removed: - ----- Method: FileExecutive>>pathDelimiter (in category 'as yet unclassified') ----- - pathDelimiter - - ^ '/' - ! Item was removed: - ----- Method: FileLocalExecutive>>defaultDirectory (in category 'accessing') ----- - defaultDirectory - - ^ self class dirClass executive: self value: defaultDirectory ! Item was removed: - ----- Method: FileLocalDosExecutive>>pathDelimiterChar (in category 'as yet unclassified') ----- - pathDelimiterChar - - ^ $\ - ! Item was removed: - ----- Method: FileLocalDosExecutive>>cleanDir: (in category 'as yet unclassified') ----- - cleanDir: aDir - - (self class OSProcessOrNil ifNil: [ ^ aDir all delete ]) waitForCommand: 'cd ', aDir,' && del \s *.*'.! Item was removed: - ----- Method: FileExecutive>>checkVoted: (in category 'instanciation') ----- - checkVoted: voted - - "alternative local executives may override this to rig the voting" - - ^ voted - - ! Item was removed: - ----- Method: FileLocalDosExecutive>>pathDelimiter (in category 'as yet unclassified') ----- - pathDelimiter - - ^ '\' - ! Item was removed: - ----- Method: FileKernel class>>initialize (in category 'as yet unclassified') ----- - initialize - - TestFileSystem := nil!

1 0

Rio: File-Base-kph.19.mcz
by squeak-dev-noreply＠lists.squeakfoundation.org 02 Mar '09

02 Mar '09

A new version of File-Base was added to project Rio: http://www.squeaksource.com/Rio/File-Base-kph.19.mcz ==================== Summary ==================== Name: File-Base-kph.19 Author: kph Time: 2 March 2009, 8:35:23 pm UUID: a79dbc77-0769-11de-a0af-000a95edb42a Ancestors: File-Base-kph.18 all test pass on unix =============== Diff against File-Base-kph.18 =============== Item was changed: ----- Method: File>>renameTo: (in category 'public file') ----- renameTo: rioable + ^ executive rename: self to: (rioable as: File)! - ^ executive rename: self to: rioable asFile! Item was changed: FileRemoteExecutive subclass: #FileFtpExecutive + instanceVariableNames: 'isKeepAlive rw' - instanceVariableNames: 'home isKeepAlive rw' classVariableNames: '' poolDictionaries: '' category: 'File-Base'! Item was changed: ----- Method: FileArchiveExecutive>>root (in category 'as yet unclassified') ----- root + ^ self class pathDelimiter - ^ self pathDelimiter ! Item was changed: ----- Method: FileFtpExecutive>>copyLocalFile:toRemoteFile: (in category 'external ftp') ----- copyLocalFile: aFile toRemoteFile: bFile + File + ospIfWin:[ :os | aFile copyTo: bFile ] + ifUnix: [ :os | os waitForCommand: 'ftp -u "', url asString , bFile , '" "' , aFile asVmPathName ,'"' ] + ifNone: [ aFile copyTo: bFile ] - self class OSProcessOrNil ifNil: [ ^ aFile copyTo: bFile ]. - - self class OSProcessOrNil waitForCommand: + ! - 'ftp -u "', url asString , bFile , '" "' , aFile asVmPathName ,'"' ! Item was changed: ----- Method: File>>renamingWith: (in category 'private') ----- renamingWith: aBlock + | old | + self isRenaming + ifTrue: [ old := self copy. + aBlock value. + self parent mkpath. + old renameTo: self ] + ifFalse: [ aBlock value ]. + + - ^ self isRenaming - ifTrue: [ self copy renameTo: aBlock value ] - ifFalse: [ aBlock value ] ! Item was changed: ----- Method: FileFtpExecutive>>ftpOpenClient (in category 'ftp client') ----- ftpOpenClient | loginSuccessful what newClient | newClient := self FTPClient openOnHostNamed: self host. loginSuccessful := false. [loginSuccessful] whileFalse: [ [loginSuccessful := true. newClient loginUser: self user password: self password] on: LoginFailedException do: [:ex | what := UIManager default chooseFrom: #('enter password' 'give up') title: 'Would you like to try another password?'. what = 1 ifFalse: [self error: 'Login failed.'. ^nil] ifTrue: [ self password: nil ]. loginSuccessful := false]]. + self setHome: newClient pwd. - home := newClient pwd. ^ newClient! Item was changed: ----- Method: File>>full: (in category 'public path') ----- full: aPathOrFile ^ self renamingWith: [ + value := executive importValue: (aPathOrFile asFile linearRelativeTo: executive homeDirectory) asString. - value := executive importValue: (aPathOrFile asFile linearRelativeTo: executive defaultDirectory) asString. ] ! Item was changed: ----- Method: FileFtpExecutive>>copyRemoteFile:toLocalFile: (in category 'external ftp') ----- copyRemoteFile: aFile toLocalFile: bFile + File + ospIfWin:[ :os | aFile copyTo: bFile ] + ifUnix: [ :os | os waitForCommand: 'ftp -o "', bFile asVmPathName, '" "' , url asString , aFile, '"' ] + ifNone: [ aFile copyTo: bFile ] - self class OSProcessOrNil ifNil: [ ^ aFile copyTo: bFile ]. - - self class OSProcessOrNil waitForCommand: + ! - 'ftp -o "', bFile asVmPathName, '" "' , url asString , aFile, '"'! Item was added: + ----- Method: File class>>ospIfWin:ifUnix:ifNone: (in category 'documentation') ----- + ospIfWin: winBlock ifUnix: unixBlock ifNone: noneBlock + | os | + + os := (Smalltalk at: #OSProcess ifAbsent: [ ^ noneBlock value ]) thisOSProcess. + + os pid ifNil: [ ^ noneBlock value ]. + + os class = WindowsProcess ifTrue: [ ^ winBlock value: os ]. + os class = UnixProcess ifTrue: [ ^ unixBlock value: os ].! Item was added: + ----- Method: File class>>ifWin:ifUnix:ifNone: (in category 'documentation') ----- + ifWin: winBlock ifUnix: unixBlock ifNone: noneBlock + | os | + + os := (Smalltalk at: #OSProcess ifAbsent: [ ^ noneBlock value ]) thisOSProcess. + + os pid ifNil: [ ^ noneBlock value ]. + + os class = WindowsProcess ifTrue: [ ^ winBlock value ]. + os class = UnixProcess ifTrue: [ ^ unixBlock value ].! Item was removed: - ----- Method: FileFtpExecutive>>externalFtp:from:to: (in category 'external ftp') ----- - externalFtp: getOrPut from: aFile to: bFile - - File tmpDo: [ :cmds | - - cmds writer: [ :str | - str << 'open ' << self host; cr. - str << 'user ' << self user << ' ' << self password; cr. - str << 'binary' ; cr. - str << getOrPut << ' "' << aFile << '" "' << bFile << '"' ; cr. - str << 'quit' ; cr. - ]. - - self class OSProcessOrNil waitForCommand: 'ftp -ig -s:' , cmds asVmPathName. - - ].!

1 0

Rio: File-Test-kph.10.mcz
by squeak-dev-noreply＠lists.squeakfoundation.org 02 Mar '09

02 Mar '09

A new version of File-Test was added to project Rio: http://www.squeaksource.com/Rio/File-Test-kph.10.mcz ==================== Summary ==================== Name: File-Test-kph.10 Author: kph Time: 2 March 2009, 4:43:46 am UUID: b74c0909-06e4-11de-a0af-000a95edb42a Ancestors: File-Test-kph.9 + Better instanciation code all round + handle line endings - all but one working on unix/macosx - 20+ failures/errors on win =============== Diff against File-Test-kph.9 =============== Item was added: + ----- Method: FileVirtualFSCommonTest>>localExecutiveClass (in category 'fixtures') ----- + localExecutiveClass + + self subclassResponsibility! Item was changed: ----- Method: FileVirtualFSDosFileTest>>testLinearRelativeTo (in category 'tests') ----- testLinearRelativeTo file := fileClass new: 'E:\hello\this\is\a\world\apart\from\here.txt'. file := file linearRelativeTo: (fileClass new: 'E:\hello\this'). self assert: (file = 'is\a\world\apart\from\here.txt'). ! Item was added: + ----- Method: FileVirtualFSDosKernelTest>>localExecutiveClass (in category 'fixture') ----- + localExecutiveClass + + ^ FileVirtualTestFSDos ! Item was changed: ----- Method: FileVirtualFSUnixFileTest>>setUp (in category 'fixture') ----- setUp fileClass := File. dirClass := Directory. + + super setUp.! - - FileLocalExecutive testFileSystem: FileVirtualTestFSUnix new. - - ! Item was added: + ----- Method: FileVirtualFSUnixKernelTest>>localExecutiveClass (in category 'fixture') ----- + localExecutiveClass + + ^ FileVirtualTestFSUnix! Item was added: + ----- Method: FileVirtualFSCommonTest>>setUp (in category 'tests-string behaviour') ----- + setUp + + self localExecutive initializeDefault! Item was changed: ----- Method: FileModeTests>>fixture: (in category 'fixtures') ----- fixture: lineEnding + file := (self useTestDir / 'crlf') binary contents: 'hello' , lineEnding , 'world'. - file := (self useTestDir / 'crlf') contents: 'hello' , lineEnding , 'world'. ! Item was added: + ----- Method: FileKernelTest>>testNew (in category 'tests-standard') ----- + testNew + self should: [ FileKernel new ] raise: Error. + ! Item was changed: ----- Method: FileVirtualFSUnixKernelTest>>setUp (in category 'fixture') ----- setUp fileClass := dirClass := FileKernel. + + super setUp.! - FileLocalExecutive testFileSystem: FileVirtualTestFSUnix new. - - ! Item was changed: ----- Method: FileVirtualFSCommonTest>>dirClass (in category 'as yet unclassified') ----- dirClass + - ^ dirClass! Item was changed: ----- Method: FileTest>>testFtp (in category 'tests') ----- testFtp + self should: [ File new: 'ftp://ftp.seasidehosting.st' ] raise: Error. + + file := Directory new: 'ftp://ftp.seasidehosting.st'. + - file := File new: 'ftp://ftp.seasidehosting.st'. self assert: file class = Directory. self assert: file executive class = FileFtpExecutive.! Item was added: + ----- Method: FileVirtualFSCommonTest>>localExecutive (in category 'fixtures') ----- + localExecutive + + ^ localExecutive ifNil: [ localExecutive := self localExecutiveClass new ]. + + ! Item was changed: ----- Method: FileKernelTest>>rootIsDirectory (in category 'tests-standard') ----- rootIsDirectory + dir := fileClass localExecutive root. - dir := fileClass new: FileLocalExecutive current root value. + self assert: (dir isRoot). self assert: (dir isDirectory). ! Item was changed: ----- Method: FileDirTest>>initialize (in category 'fixtures') ----- initialize + testDir := Directory cwd / 'testing_file'. + destDir := Directory cwd / 'testing_file_dest'.! - testDir := Cwd / 'testing_file'. - destDir := Cwd / 'testing_file_dest'.! Item was changed: ----- Method: FileVirtualFSDosKernelTest>>setUp (in category 'fixture') ----- setUp fileClass := dirClass := FileKernel. + super setUp.! - FileLocalExecutive testFileSystem: FileVirtualTestFSDos new. - - ! Item was changed: ----- Method: FileTest>>testFileAppendString (in category 'tests') ----- testFileAppendString + self testDirFromString. + newFile := dir / 'user'. - self testFileFromString. - newFile := file / 'user'. self deny: newFile == file. self assert: newFile = '/home/user'! Item was changed: ----- Method: FileVirtualTestFSUnix>>dirClass (in category 'as yet unclassified') ----- dirClass ^ Notification new tag: #dirClass; signal! Item was added: + ----- Method: FileTest>>testNew (in category 'tests') ----- + testNew + self should: [ File new ] raise: Error. + ! Item was changed: ----- Method: FileTest>>testCwdAppendString (in category 'tests') ----- testCwdAppendString | file2 | + dir := Directory new. + file2 := dir / 'user'. - file := File new. - file2 := file / 'user'. self deny: file2 == file. self assert: file2 asString = 'user'! Item was added: + ----- Method: FileTest>>testDirFromString (in category 'tests') ----- + testDirFromString + dir := Directory new: '/home'. + self assert: dir = '/home'! Item was changed: ----- Method: FileTest>>testExists (in category 'tests') ----- testExists self assert: self thisImage exists. self assert: self thisImage parent exists. + self assert: (File new: (self thisImage fileName)) exists. + self deny: (self thisImage parent / 'blah') exists. + self deny: (File new: 'blah') exists! - self deny: (self thisImage / 'blah') exists! Item was changed: ----- Method: FileTest>>testHttp (in category 'tests') ----- testHttp + self should: [ File new: 'http://www.google.com' ] raise: Error. + dir := Directory new: 'http://www.google.com'. + self assert: dir class = Directory. + self assert: dir executive class = FileHttpExecutive. + + file := File new: 'http://www.google.com/index.html'. + + self assert: file class = File. - file := File new: 'http://www.google.com'. - self assert: file class = Directory. self assert: file executive class = FileHttpExecutive! Item was changed: TestCase subclass: #FileVirtualFSCommonTest + instanceVariableNames: 'file fileClass dirClass localExecutive' - instanceVariableNames: 'file fileClass dirClass' classVariableNames: '' poolDictionaries: '' category: 'File-Test'! Item was changed: ----- Method: FileVirtualFSCommonTest>>runCaseWith: (in category 'as yet unclassified') ----- runCaseWith: aBlock + [ self localExecutive pretendDuring: aBlock ] on: Notification do: [ :ex | ex resume: (self perform: ex tag) ]! - aBlock on: Notification do: [ :ex | ex resume: (self perform: ex tag) ]! Item was changed: ----- Method: FileDirTest>>testAddFile (in category 'tests-directory copying') ----- testAddFile | result | self makeDirectoriesAndFiles. + result := destDir mkpath add: (testDir / 't_a' / 'f 1') asFile. - result := destDir mkpath add: (testDir / 't_a' / 'f 1'). + self assert: (destDir all entries size = 1). - self assert: (destDir all entries size = 1). ! Item was added: + ----- Method: FileVirtualTestFSUnix>>checkVoted: (in category 'as yet unclassified') ----- + checkVoted: voted + + "alternative local executives may override this to rig the voting" + + "we rig the voting so we win if the winner is the executive we are spoofing" + + ^ voted = self class superclass ifTrue: [ ^ self class ] ifFalse: [ voted ] + ! Item was added: + ----- Method: FileTest>>testPlusExtend (in category 'tests') ----- + testPlusExtend + self testFileFromString. + newFile := file + '.dir'. + self deny: newFile == file. + self assert: newFile = '/home.dir'! Item was added: + ----- Method: FileVirtualTestFSDos>>checkVoted: (in category 'as yet unclassified') ----- + checkVoted: voted + + "alternative local executives may override this to rig the voting" + + "we rig the voting so we win if the winner is the executive we are spoofing" + + ^ voted = self class superclass ifTrue: [ ^ self class ] ifFalse: [ voted ] + ! Item was changed: ----- Method: FileVirtualFSCommonTest>>currentFileSystem (in category 'fixtures') ----- currentFileSystem + ^ FileKernel localExecutive! - ^ FileLocalExecutive current! Item was changed: ----- Method: FileModeTests>>testReadingCrLf (in category 'fixtures') ----- testReadingCrLf " self debug: #testReadingCrLf. " + | m | self fixture: String crlf. + + file asciiCrLf. file reader: [ :r | + self assert: ((m := r nextLine) = 'hello'). + self assert: ((m := r nextLine) = 'world'). - self assert: (r nextLine = 'hello'). - self assert: (r nextLine = 'world'). self assert: r atEnd. ].! Item was added: + ----- Method: FileDirTest>>testNew (in category 'tests-directory copying') ----- + testNew + self assert: (Directory new asString = ''). + self assert: (Directory new class = Directory). + self assert: (Directory new exists). + + + + + ! Item was changed: ----- Method: FileVirtualFSDosFileTest>>setUp (in category 'fixture') ----- setUp fileClass := File. dirClass := Directory. + super setUp.! - FileLocalExecutive testFileSystem: FileVirtualTestFSDos new. - - ! Item was removed: - ----- Method: FileVirtualFSCommonTest>>tearDown (in category 'fixtures') ----- - tearDown - - FileLocalExecutive testEnd! Item was removed: - ----- Method: FileVirtualTestFSDos>>dirClass (in category 'as yet unclassified') ----- - dirClass - - ^ Notification new tag: #dirClass; signal! Item was removed: - ----- Method: FileVirtualTestFSDos>>fileClass (in category 'as yet unclassified') ----- - fileClass - - ^ Notification new tag: #fileClass; signal! Item was removed: - ----- Method: FileVirtualTestFSUnix>>initialize (in category 'as yet unclassified') ----- - initialize - - self initializeDefault! Item was removed: - ----- Method: FileVirtualTestFSDos>>initialize (in category 'as yet unclassified') ----- - initialize - - self initializeDefault! Item was removed: - ----- Method: FileTest>>testRioExtend (in category 'tests') ----- - testRioExtend - self testFileFromString. - newFile := file + '.dir'. - self deny: newFile == file. - self assert: newFile = '/home.dir'!

1 0

Rio: File-Base-kph.18.mcz
by squeak-dev-noreply＠lists.squeakfoundation.org 02 Mar '09

02 Mar '09

A new version of File-Base was added to project Rio: http://www.squeaksource.com/Rio/File-Base-kph.18.mcz ==================== Summary ==================== Name: File-Base-kph.18 Author: kph Time: 2 March 2009, 4:42:12 am UUID: 7f381970-06e4-11de-a0af-000a95edb42a Ancestors: File-Base-kph.17 + Better instanciation code all round + handle line endings =============== Diff against File-Base-kph.17 =============== Item was added: + ----- Method: File class>>new: (in category 'as yet unclassified') ----- + new: aPathOrFile + + ^ self localExecutive newOfClass: self from: aPathOrFile asString + ! Item was changed: ----- Method: File>>readStream (in category 'adaptor') ----- readStream | reader | reader := self basicReader ifNil: [ ^ nil ]. self isBinary ifTrue: [ reader binary ] + ifFalse: [ reader lineEndConvention: lineEndConvention ]. - ifFalse: [ reader wantsLineEndConversion: true ]. ^ reader! Item was changed: ----- Method: FileRemoteExecutive class>>makeNew:from: (in category 'as yet unclassified') ----- makeNew: aClass from: aString + | exec path theUrl value | - | exec path theUrl | theUrl := aString asUrl. path := String new writeStream. theUrl path do: [ :pathElem | path nextPut: $/. path nextPutAll: pathElem ]. theUrl path: #(). exec := self executiveForUrl: theUrl. + value := path contents. + + (value = '/' and: [ aClass ~= Directory ]) ifTrue: [ self error: 'not a file, please use asDirectory' ]. + ^ aClass executive: exec value: value.! - ^ aClass executive: exec value: path contents.! Item was changed: ----- Method: Directory>>asFile (in category 'directory/container actions') ----- asFile + ^ self as: File! - ^ File newFrom: self! Item was changed: ----- Method: File class>>thisVm (in category 'as yet unclassified') ----- thisVm + ^ self new: (self localExecutive primVmPath)! - ^ self new: (self defaultExecutive primVmPath)! Item was added: + ----- Method: File>>lineEndConvention (in category 'public file') ----- + lineEndConvention + + ^ lineEndConvention! Item was added: + ----- Method: FileXML class>>validExtensions (in category 'as yet unclassified') ----- + validExtensions + + ^ #( 'xml' 'plist' 'xhtml' )! Item was added: + ----- Method: File class>>validExtensions (in category 'documentation') ----- + validExtensions + + ^ #()! Item was changed: ----- Method: File>>gzip (in category 'public modes') ----- gzip + ^ self as: FileGzip! - ^ FileGzip newFrom: self! Item was added: + ----- Method: FileFtpExecutive>>startAt:recursively:select:excluding:into: (in category 'basic') ----- + startAt: rioOrString recursively: beRecursive select: selectBlock excluding: xList into: results + + "Return a collection of rio's selected by passing + the directoryEntry array to the selectBlock. + + This can be called with startAt: aString, but if so beRecursive must be false. + + See primLookupEntryIn:index: for further details." + + | entry isDir fName | + + (self ftpGetDirectory: home, rioOrString asVmPathName) keysAndValuesDo: [ :index :entryArray | + + fName := entryArray at: 1. + + (xList includes: fName) ifFalse: [ + + isDir := entryArray at: 4. + + entry := ((isDir ifTrue: [ self class dirClass ] ifFalse: [ self class fileClass ]) + executive: self value: rioOrString) + pathJoin: fName; + setStatFromDir: rioOrString andEntryArray:entryArray; + yourself. + + (selectBlock value: entry) ifTrue: [ results add: entry ]. + + (beRecursive and: [ isDir ]) + ifTrue: [ + self + startAt: entry + recursively: beRecursive + select: selectBlock + excluding: xList + into: results + ] + ] + + ]. + + ^ results! Item was changed: ----- Method: FileGzip class>>validExtensions (in category 'as yet unclassified') ----- validExtensions + ^ #( 'gz' 'gzip' )! - ^ #( 'gz' )! Item was added: + ----- Method: String>>asFile (in category '*file-base') ----- + asFile + + ^ ((File classForPathWithExtension: self) ifNil: [ File ]) new: self! Item was changed: ----- Method: Directory>>/ (in category 'directory/container actions') ----- / morePath + ^ self copy pathJoin: morePath! - ^ self newFrom: (self pathJoin: morePath)! Item was changed: ----- Method: Directory class>>untrusted (in category 'as yet unclassified') ----- untrusted + ^ self localExecutive untrustedDirectory ! - ^ self defaultExecutive untrustedDirectory ! Item was added: + ----- Method: File class>>classForPathWithExtension: (in category 'documentation') ----- + classForPathWithExtension: aPath + + | ext | + ext := aPath copyAfterLast: $.. + + self allSubclassesDo: [ :c | (c validExtensions includes: ext) ifTrue: [ ^ c ] ]. + + ^ nil + ! Item was changed: ----- Method: FileFtpExecutive>>copyUsing:from:to:relativeTo: (in category 'local/remote file copy') ----- copyUsing: aSelector from: aDir to: someFD relativeTo: aBaseDir "here we do two passes, first we ensure that all of the needed directories exist. for this we use our ususal ftp client. for the file transfers themselves we run n threads feeding from a shared queue " | queue map done delay flg dest | + flg := FileNotification isOverwrite. - flg := FileNotification signal isOverwrite. self ftpDo: [ :ftp | - map := self toDir: aDir mkpathAll: someFD relativeTo: aBaseDir. map := map select: [ :ea | dest := ea second. dest isDirectory not and: [ flg or: [ dest exists not ] ] ] ]. delay := Delay forMilliseconds: 100. queue := SharedQueue2 new setItems: map copy. done := SharedQueue2 new. self class prefFtpParallel timesRepeat: [ [ [ queue isEmpty ] whileFalse: [ queue nextOrNil ifNotNilDo: [ :ea | [ self perform: aSelector withArguments: ea ] ensure: [ done nextPut: ea ]. ] ] ] fork. ]. [ done size < map size ] whileTrue: [ delay wait ]. ^ map collect: [ :ea | ea second ]! Item was added: + ----- Method: File class>>documentationExtensions (in category 'documentation') ----- + documentationExtensions + " + StandardFileStream-#retryWithGC: execBlock until: testBlock forFileNamed: fullName + + trivial change allows fullName to be passed in as a rio, since the rio handles the equivalent of String-sameAs:. However + rio's implementation of sameAs: can be adjusted according to the platform. + _ + Object-#isFileOrDirectory for testing + _ + String-#asFile for conveniance + String-#asDirectory for conveniance + + _ + FileStream close now returns the file i.e. the File instance that opened it. + Stream use: [ :str | ] now includes an ensure close block, + and returns the return value of that close. + _ + FileDirectory-#fullNameFor: + adding asString allows a Rio to be passed in to many FileDirectory functions. + + "! Item was added: + ----- Method: FileArchiveExecutive>>startAt:recursively:select:excluding:into: (in category 'as yet unclassified') ----- + startAt: rioOrString recursively: beRecursive select: selectBlock excluding: xList into: results + + "this unpleasent method repackages the flat archive as a hierarchical structure that + can be recursively traversed like a normal directory." + + | membersBelow subDirs dir | + + membersBelow := archive members. + + rioOrString isEmpty + ifTrue: [ + dir := ''. + ] + ifFalse: [ + dir := rioOrString value. + dir last ~= $/ ifTrue: [ dir := dir , '/' ]. + membersBelow := membersBelow select: [ :member | + (member fileName ~= dir) and: [member fileName beginsWith: dir] + ]. + ]. + + subDirs := (membersBelow reject: [:member | xList includes: member fileName ]) + + select: [ :member | + | pathBelow entry | + pathBelow := member fileName allButFirst: dir size. + pathBelow last = $/ ifTrue: [ pathBelow := pathBelow allButLast ]. + (pathBelow includes: $/) + ifFalse: [ + + entry := member isDirectory + ifTrue: [ self class dirClass executive: self value: member fileName ] + ifFalse: [ self class fileClass executive: self value: member fileName ]. + + entry setStatFromDir: rioOrString andEntryArray: + (Array + with: pathBelow + with: "member lastModTime" 0 + with: "member lastModTime" 0 + with: member isDirectory). + (selectBlock value: entry) ifTrue: [ results add: entry ]. + false + ] + ifTrue: [ true ]. + ]. + + beRecursive ifTrue: [ + subDirs do: [ :aDir | + self startAt: aDir fileName recursively: beRecursive select: selectBlock excluding: xList into: results + ]. + ]. + + ^ results! Item was changed: ----- Method: File class>>/ (in category 'as yet unclassified') ----- + / aPathable - / a + "we are the local cwd" + ^ self localExecutive in: [:exec | + exec dirClass executive: exec value: aPathable asString + ] - ^ Directory new: a ! Item was added: + ----- Method: Directory class>>new (in category 'as yet unclassified') ----- + new + + ^ Directory fromString: ''! Item was changed: FileKernel subclass: #File instanceVariableNames: 'recursive rename adaptor binary' classVariableNames: '' poolDictionaries: '' category: 'File-Base'! + !File commentStamp: 'test 3/1/2009 04:03' prior: 0! + (see also #documentationExtensions) + + Features Overview + + File/Directory was inspired by ruby's rio which enables local, remote, and archived file systems to be used transparently. To achieve this a generic stream copy function has been developed (aStream copyTo: bStream) and we are able to expose the working stream of FtpClient so you can stream directly to a remote file. We also support transparent streaming to compressed files (gzip) and (plan to) support file archives (zip) as if they were a filesystem. Transparent streaming to a remote compressed file is still available as a exercise for the reader to implement ;) - !File commentStamp: 'kph 11/24/2008 11:28' prior: 0! - File/Directory was inspired by ruby's rio which enables local and remote files to be used transparently. To achieve this a generic stream copy function has been developed (aStream copyTo: bStream) and we are able to expose the working stream of FtpClient so you can stream directly to a remote file. We also support file archives (zip) as if they were a filesystem, and transparent streaming to compressed files (gzip). [transparent streaming to a remote compressed file is still available as a exercise for the reader to implement ;) ] File/Directory is a standalone package, it does not use any of the existing FileDirectory classes. It is separated into File-Kernel and File-Base, where the former provides a minimal working subset for KernelImages to access local filesystems. Local file copying is handled by the fileCopyPlugin if it is present, if not OSProcess 'cp' is used, and as a last resort a full stream to stream copyTo: is performed (but this does update modification time). + Remote file upload or download is handled by OSProcess 'ftp' if it is present. Multiple file transfers (#addAll: #addTree:) are invoked N at a time (where N is initially 5). Copying from a remote file to another remote file is handled by the internal stream copy function between two internal FTPClients. + + Instanciation: + + The main instanciation is via: File new: 'file. Directory new: 'dir'. FileXML new: 'blah.xml' etc. (where new: calls fromString:) + Conversion between file types/mode subclasses is avaiable via: #as: e.g. (File new:'file.xml') as: FileXML. (e.g. #xml #gzip) + + 'file' asFile. 'aDirectory asDirectory. - are provided as readable, intelligent, convenience methods. + #asFile attempts to interpet any fileExtension according to those registered in #validExtensions. + + All operations including instanciation are performed by an executive, the local file system executive is available via #localExecutive. "Pretending" is supported, in the event that you wish File/Directory to pretend to be on another file system. + (FileLocalDosExecutive executiveForVolume: 'G:\') pretendDuring: [ FileKernel localExecutive ] --> FileLocalDosExecutive(G:\) + Pretending uses Notifications, when it is enabled, but not otherwise, so in normal use there is no speed penalty for local executive look up. + + Files are told of the local line ending convention on instanciation. You can override this when you set the ascci mode asciiCr/asciiCrLf/asciiLf + + + - Remote file upload or download is handled by OSProcess 'ftp' if it is present. Multiple file transfers are invoked N at a time (where N is initially 5). Copying from a remote file to another remote file is handled by the internal stream copy function. Caveats: No explicit support has been coded for alternative character encodings for paths. File paths are stored as Strings and sent to primitives via asVmPathname. Known Issues (features): A File/Directory instance on windows, when moved to a unix machine will refer to the file with that path name (with \s) in the local directory. This allows a unix machine to provide an alias to the correct location. (thats the theory anyway) We define $/ as the standard delimieter for use within Squeak, translating for the underlying filesystem as needed. The #executive covers the interaction with the actual file system, and there is an executive for file systems with case insensitive filenames. #rmdir does check for existence of the directory first (an improvement on legacy already!!) #select: Provides the core of the implementation. It provides the basis for even the simpleset #stat or complex queries such as "files older than", and it has a recursive mode (#all) which applies to all uses of #select: Mode changes instanciate a fresh instance, existing instances are effectively immutable. Stat results are cached, and the cache is shared by all references pointing to that file. ilable as a Class, enabling the readable form: Cwd / 'hello.txt' in code Cool Null support for the following has been removed. myFile := myFileRio ifFile reading. newRio := myFileRio ifFile renameTo: 'newname'. Rather than have #renameTo:overwriting: the following does the same job just as concisely. oldRio renameTo: (newRio delete). oldRio renameTo: (newRio forceNewFile). is equivalent also. Ruby Rio has the ability to tell the rio what the expected extension is, which it then takes into account when calculating the #basename then takes into account. So there is an #ext and an #extname, which gets kind of confusing. So if we simply define basename as the #fileName upto the last $., and the ext as the rest that should be enough. Implementing #delete. '\' asRio deleteTree may not be a good idea!! Do we need a guard. Ok, lets set it so that #delete wil do the job of deleteTree if the recursive flag is set. usage: aRio all rmdir - makes sense usage: aRio rmdir - makes sense if dir is empty. Function of 'force'NewFileNamed: is now handled by fileStream := aRio delete writer. fileStream := aRio forceNewFile writer. And the block case, instead of implementing three methods. aRio reader: [ :str | ]. aRio appender: [ :str | ]. myRio := aRio delete writer use: [ :str | str, 'hello'; cr ]. we use #use: which unlike #in: ensures the stream is closed for us aRio writer use: [ :str | ]. aRio writer use: [ :str | ]. FileStream #close to return the stream's rio (none of the existing senders of #close use the return value) this allows continuing with the rio after the cascade, or using the result in assigment. (myRio writer << 'a bit' << 'abit more') close isFile ifTrue: [ 'it s a file' ] myRio := ('test' asRio writer << 'a bit' << 'a bit more') close. myRio := 'test' asRio writer: [ :w | w,'hello';cr ]. myRio read contents. Defined #reader: and #writer: to take a block. instead of aRio reader use: [ :str | ], you can write aRio reader: [ :inStream | ... ]. instead of aRio writer use: [ :str | ], you can write aRio writer: [ :outStream | ... ]. #appender: is also available and is equivalent to writer: [ :out | out setToAppend. out ... ]. Copying multiple files to a directory or archive: aDirectory copyTo: bDirectory. Could be done as aDirectory entries copyTo: bDirectory, but we havent got any methods on OrderedCollection to do that with, so it would have to be. bDirectory copyFrom: aDirectory all entries. That doesnt read correctly and it looks like you might be overwriting bDirectory. I think that "bDirectory addAll: aDirectory all entries" is fairly unambiguous. aFile copyTo: bDirectory makes sense but rather than overload #copyTo: with multiple behavours , lets keep it file to file only, and use bDirectory add: aFile as an equally unambigous version. To be useful when adding a tree of directory and files we need to know the base directory we are starting from, and all of the files as relative paths to that pase directory. The implementation of simpleRelativeTo: is brilliantly simple especially compared to the methods used in Archive-addTree: etc. The result is a quite simple and versatile, 1. aDirectory add: aFile , 2. aDirectory addAll: acollection - e.g. aDirectory addAll: (myOutput all filesMatching: #('*.image' '*.changes') ). 3. aDirectory addTree: aDirectory (and all of its contents). 4. The generic version of addTree: which can be used with a hand crafted collection of files, missing directories are created. aDirectory addAll: aCollection fromBase: aDirectory RioFtpFileSystem executive depends upon MCPasswordManager to look after passwords. + Note: #select:/#entries/filesMatching: etc do not walk '__MACOSX' or '.DS_Store', but 'test' all delete does.! - ! Item was changed: ----- Method: File>>rmdir (in category 'public dir') ----- rmdir "as a minor saftey precaution, the directory must be empty or we must be explicitly set in recursive mode (rmdir resets recursive mode). " self isDirectory ifFalse: [ ^self ]. self isRecursive ifTrue: [ recursive := false. + (executive in: self excluding: #() select: [:d | true ]) + do: [ :ea | ea beRecursive delete ]. + recursive := true ]. - self entries do: [:d | d beRecursive delete ] ]. executive deleteDirectory: self ! Item was added: + ----- Method: File>>asciiLf (in category 'public modes') ----- + asciiLf + + binary := false. + lineEndConvention := #lf.! Item was added: + ----- Method: File class>>new (in category 'as yet unclassified') ----- + new + + ^ self error: 'File new - is invalid use Directory new'! Item was changed: ----- Method: File>>xml (in category 'public modes') ----- xml + ^ self as: FileXML! - ^ FileXML newFrom: self! Item was added: + ----- Method: FileFtpExecutive>>in:excluding:select: (in category 'basic') ----- + in: aRio excluding: xList select: selectBlock + + ^ self ftpDo: [ :c | super in: aRio excluding: xList select: selectBlock ]! Item was changed: ----- Method: File>>asDirectory (in category 'public modes') ----- asDirectory + ^ self as: Directory! - ^ Directory newFrom: self! Item was added: + ----- Method: File>>lineEndConvention: (in category 'public file') ----- + lineEndConvention: aSymbol + + lineEndConvention := aSymbol! Item was changed: ----- Method: File>>contents: (in category 'public file') ----- contents: aStreamAble "aStreamable refers to implementers of << and hence putOn: And so would write out an array of strings" + ^ self asFile writer: [ :out | out << aStreamAble ].! - self writer: [ :out | out << aStreamAble ].! Item was changed: ----- Method: Directory class>>root (in category 'as yet unclassified') ----- root + ^ self localExecutive root! - ^ self defaultExecutive current root! Item was added: + ----- Method: File>>asciiCr (in category 'public modes') ----- + asciiCr + + binary := false. + lineEndConvention := #cr.! Item was added: + ----- Method: String>>asDirectory (in category '*file-base') ----- + asDirectory + + ^ Directory new: self! Item was added: + ----- Method: File>>asciiCrLf (in category 'public modes') ----- + asciiCrLf + + binary := false. + lineEndConvention := #crlf.! Item was changed: ----- Method: File>>from: (in category 'copying instanciation') ----- from: pathOrRio + pathOrRio isEmpty ifTrue: [ value := '']. - (pathOrRio isEmpty and: [ self class name ~= #Cwd ]) ifTrue: [ value := '']. (pathOrRio isKindOf: FileKernel) ifTrue: [ self setStat: pathOrRio getStat. pathOrRio isBinary ifTrue: [ self beBinary ]. ]. ^ self value: pathOrRio! Item was changed: ----- Method: Directory class>>tmp (in category 'as yet unclassified') ----- tmp + ^ self localExecutive getTempDirectory ! - ^ self defaultExecutive current getTempDirectory ! Item was added: + ----- Method: Directory class>>cwd (in category 'as yet unclassified') ----- + cwd + + ^ Directory fromString: ''! Item was removed: - ----- Method: File class>>instantiation (in category 'documentation') ----- - instantiation - " - Rio has an instanciation scheme which provides many dimensions for specialisation, dividing - responsibilities logically among the components involved. - - A path string can specify a specialised protocol which refers to a particular domain - e.g. ftp remote host. The domain executive may in turn choose which class to represent - the elements which it manages. The elements perform all primitive manipulations - via the domain executive. - - Typical Instanciation Route: - - <aPathString> asRio. - gives an instance of Rio, via Rio new: aPathOrARio - - Rio #new: traverses its subclasses asking if any #canInstanciate: so as to allow - specific subclasses to handle protocols, or any other encoded-in-path-string specialisations. - As a fallback Rio handles the default case. - - The elected class, is sent #new in order to create an empty instance, which will be populated #from: <aPathString> - - The default behaviour of #new is to ask the #defaultExecutive, 'LocalFileSystemCurrent' to instanciate an instance that implements the appropriate behaviour for that domain via: #makeNewRioOfClass: <theClass>, the default be being <theClass>-#basicNew. - "! Item was removed: - ----- Method: File>>linearRelativeTo: (in category 'public dir') ----- - linearRelativeTo: aDirectoryOrFile - | tmp | - self full = aDirectoryOrFile full ifTrue: [ ^ Directory new: '' ]. - - tmp := (self parent linearRelativeTo: aDirectoryOrFile) / self fileName. - - ^tmp - ! Item was removed: - ----- Method: File>>asUrl (in category 'public modes') ----- - asUrl - - ^ executive toUrl: self! Item was removed: - ----- Method: FileFtpExecutive>>in:select: (in category 'basic') ----- - in: aRio select: selectBlock - - ^ self ftpDo: [ :c | super in: aRio select: selectBlock ]! Item was removed: - ----- Method: File class>>newDirectoryFrom: (in category 'as yet unclassified') ----- - newDirectoryFrom: aPath - - ^ self defaultExecutive current class newDirectoryFrom: aPath! Item was removed: - ----- Method: Cwd>>printOn: (in category 'as yet unclassified') ----- - printOn: str - - str , '(', self class name, ' new)' - - ! Item was removed: - ----- Method: FileFtpExecutive>>startAt:recursively:select:into: (in category 'basic') ----- - startAt: rioOrString recursively: beRecursive select: selectBlock into: results - - "Return a collection of rio's selected by passing - the directoryEntry array to the selectBlock. - - This can be called with startAt: aString, but if so beRecursive must be false. - - See primLookupEntryIn:index: for further details." - - | entry isDir | - - (self ftpGetDirectory: home, rioOrString asVmPathName) keysAndValuesDo: [ :index :entryArray | - - (entry := rioOrString / (entryArray at: 1)) - setStatFromDir: rioOrString andEntryArray:entryArray. - - isDir := entryArray at: 4. - - isDir ifFalse: [ entry := entry asFile ]. - - (selectBlock value: entry) ifTrue: [ results add: entry ]. - - (beRecursive and: [ isDir ]) - ifTrue: [ - self - startAt: entry - recursively: beRecursive - select: selectBlock - into: results - ]. - - ]. - - ^ results! Item was removed: - Directory subclass: #Cwd - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'File-Base'! Item was removed: - ----- Method: Cwd>>newFrom: (in category 'as yet unclassified') ----- - newFrom: pathOrFile - - ^ File executive: executive value: pathOrFile! Item was removed: - ----- Method: FileArchiveExecutive>>startAt:recursively:select:into: (in category 'as yet unclassified') ----- - startAt: rioOrString recursively: beRecursive select: selectBlock into: results - - "this unpleasent method repackages the flat archive as a hierarchical structure that - can be recursively traversed like a normal directory." - - | membersBelow subDirs dir | - - membersBelow := archive members. - - rioOrString isEmpty - ifTrue: [ - dir := ''. - ] - ifFalse: [ - dir := rioOrString value. - dir last ~= $/ ifTrue: [ dir := dir , '/' ]. - membersBelow := membersBelow select: [ :member | - (member fileName ~= dir) and: [member fileName beginsWith: dir] - ]. - ]. - - subDirs := membersBelow select: [ :member | - | pathBelow entry | - pathBelow := member fileName allButFirst: dir size. - pathBelow last = $/ ifTrue: [ pathBelow := pathBelow allButLast ]. - (pathBelow includes: $/) - ifFalse: [ - - - entry := member isDirectory - ifTrue: [ self class dirClass executive: self value: member fileName ] - ifFalse: [ self class fileClass executive: self value: member fileName ]. - - entry setStatFromDir: rioOrString andEntryArray: - (Array - with: pathBelow - with: "member lastModTime" 0 - with: "member lastModTime" 0 - with: member isDirectory). - (selectBlock value: entry) ifTrue: [ results add: entry ]. - false - ] - ifTrue: [ true ]. - ]. - - beRecursive ifTrue: [ - subDirs do: [ :aDir | - self startAt: aDir fileName recursively: beRecursive select: selectBlock into: results - ]. - ]. - - ^ results! Item was removed: - ----- Method: Cwd>>split (in category 'as yet unclassified') ----- - split - - ^ Array new! Item was removed: - ----- Method: File>>os (in category 'public modes') ----- - os - - ^ RioOSProcess new: self! Item was removed: - ----- Method: File>>asMatchedList (in category 'enumeration') ----- - asMatchedList - - ^ self parent filesMatching: self fileName! Item was removed: - ----- Method: File class>>extensions (in category 'documentation') ----- - extensions - " - StandardFileStream-#retryWithGC: execBlock until: testBlock forFileNamed: fullName - - trivial change allows fullName to be passed in as a rio, since the rio handles the equivalent of String-sameAs:. However - rio's implementation of sameAs: can be adjusted according to the platform. - _ - Object-#isRio for testing - _ - String-#asRio for coercion - _ - FileStream close now returns the file i.e. the Rio that opened it. - Stream in: [ :str | ] now includes an ensure close block, - and returns the return value of that close. - _ - FileDirectory-#fullNameFor: - - adding asString allows a Rio to be passed in to many FileDirectory functions. - - "! Item was removed: - ----- Method: Cwd class>>new: (in category 'public instanciation') ----- - new: pathOrFile - - ^ Directory new: pathOrFile! Item was removed: - ----- Method: File class>>newFileFrom: (in category 'as yet unclassified') ----- - newFileFrom: aPath - - ^ self defaultExecutive current class newFileFrom: aPath!

1 0

Rio: File-Kernel-kph.15.mcz
by squeak-dev-noreply＠lists.squeakfoundation.org 02 Mar '09

02 Mar '09

A new version of File-Kernel was added to project Rio: http://www.squeaksource.com/Rio/File-Kernel-kph.15.mcz ==================== Summary ==================== Name: File-Kernel-kph.15 Author: kph Time: 2 March 2009, 4:41:46 am UUID: 6fe5f618-06e4-11de-a0af-000a95edb42a Ancestors: File-Kernel-kph.14 + Better instanciation code all round + handle line endings =============== Diff against File-Kernel-kph.14 =============== Item was changed: ----- Method: FileExecutive>>basicReader: (in category 'as yet unclassified') ----- basicReader: aFile + ^ aFile fileStream open: aFile forWrite: false! - ^ self class fileStreamClass new open: aFile forWrite: false! Item was changed: ----- Method: FileExecutive>>toDirLocal:addAllLocal:relativeTo: (in category 'local/remote file copy') ----- toDirLocal: aDir addAllLocal: someFD relativeTo: aBaseDir | map overwrite dest | + overwrite := FileNotification isOverwrite. - overwrite := FileNotification signal isOverwrite. map := self toDir: aDir mkpathAll: someFD relativeTo: aBaseDir. ^ map collect: [ :ea | dest := ea second. (dest isDirectory not and: [ overwrite or: [ dest exists not ] ]) ifTrue: [ self copyLocalFile: ea first toLocalFile: dest ]. dest ]. ! Item was changed: ----- Method: FileExecutive>>root (in category 'as yet unclassified') ----- root + ^ self class dirClass executive: self value: self rootString! - ^ self class makeNew: self class dirClass from: self rootString! Item was changed: ----- Method: FileExecutive>>mkpath: (in category 'as yet unclassified') ----- + mkpath: aDIr - mkpath: aRio + aDIr isDirectory ifTrue: [ ^self ]. + aDIr parent mkpath. + self createDirectory: aDIr. ! - aRio isDirectory ifTrue: [ ^self ]. - aRio parent mkpath. - self createDirectory: aRio. ! Item was changed: ----- Method: FileLocalExecutive>>createDirectory: (in category 'executive actions') ----- + createDirectory: aDir - createDirectory: aRio + ^ self primCreateDirectory: aDir asVmPathName ! - ^ self primCreateDirectory: aRio asVmPathName ! Item was added: + ----- Method: FileLocalExecutive>>print:on: (in category 'pretending') ----- + print: aFileKernel on: str + + str << $( << aFileKernel class name << ' new: ''' << aFileKernel value << ''')' + + ! Item was changed: ----- Method: FileLocalExecutive>>defaultDirectory (in category 'accessing') ----- defaultDirectory + ^ self class dirClass executive: self value: defaultDirectory ! - ^ defaultDirectory asDirectory! Item was changed: ----- Method: FileKernel>>fileName: (in category 'accessing') ----- fileName: newFileName self splitToPathAndName: [ :dirPath :fileName | + value := executive importValue: dirPath. + self pathJoin: newFileName. - value := executive importValue: ((self newFrom: dirPath) pathJoin: newFileName) asString ].! Item was changed: ----- Method: FileLocalExecutive>>getImageDirectory (in category 'executive actions') ----- getImageDirectory + ^ self getImageFile parent ! - ^ (self dirClass executive: self value: self primImagePath) parent ! Item was added: + ----- Method: FileNotification>>executive (in category 'accessing') ----- + executive + + ^ executive ifNil: [ FileLocalExecutive local ]! Item was added: + ----- Method: FileExecutive>>lineEndConvention (in category 'instanciation') ----- + lineEndConvention + + ^ #lf! Item was changed: ----- Method: FileLocalDosExecutive>>getTempDirectory (in category 'as yet unclassified') ----- getTempDirectory + ^ self class dirClass new: 'C:\WINDOWS\TEMP\'! - ^ self dirClass new: 'C:\WINDOWS\TEMP\'! Item was added: + ----- Method: FileExecutive>>newOfClass:from: (in category 'instanciation') ----- + newOfClass: aClass from: aPathString + "this is the core instanciation method" + + | voted new | + + "take a vote, if anyone wants to be the executive for this path" + voted := self class classForPath: aPathString. + + voted := self checkVoted: voted. + + new := voted ifNotNil: [ voted makeNew: aClass from: aPathString ] + ifNil: [ aClass executive: self value: aPathString ]. + + ^ new lineEndConvention: self lineEndConvention; yourself! Item was added: + ----- Method: FileLocalExecutive class>>local (in category 'accessing current') ----- + local + + ^ Local + ! Item was added: + ----- Method: SocketStream>>lineEndConvention: (in category '*file-kernel') ----- + lineEndConvention: aSymbol + "dummy for compat with MultiByteCharacterStream" + + ! Item was changed: FileExecutive subclass: #FileLocalExecutive instanceVariableNames: 'rootString root defaultDirectory' + classVariableNames: 'Dynamic Fixed Local' - classVariableNames: 'Current Test' poolDictionaries: '' category: 'File-Kernel'! !FileLocalExecutive commentStamp: 'kph 4/17/2007 19:25' prior: 0! Introducing the idea that Rio's exist in the context of their 'physical container', we have the RioLocalFileSystem as the primary container which provides the file system interface, also known as the 'executive'. On unix there is one executive for the whole system. On dos there is one executive per volume. This approach also supports the notion of files within archives and files on remote servers. On startup, having a formal model of the host filesystem allows us to keep a current and previous instance introducing the possibility for migrating Rio's on startup when the image has been moved. For example C:/ could be replaced with /mnt/hda1 thus attempting to make images properly portable. (experimental idea) ! Item was changed: ----- Method: FileKernel class>>new: (in category 'as yet unclassified') ----- new: aPathOrFile + ^ self fromString: aPathOrFile asString! - "the preferred generic instanciation method, - will call the correct specific instanciation method on the correct class" - - (aPathOrFile isKindOf: FileKernel) ifTrue: [ ^ aPathOrFile copy ]. - - ^ self defaultExecutive current class newDirectoryFrom: aPathOrFile! Item was changed: ----- Method: FileLocalExecutive class>>initialize (in category 'class initialization') ----- initialize Smalltalk addToStartUpList: self after: Delay. + Local := self newForThisPlatform initializeDefault. - Current := self newForThisPlatform. - Current initializeDefault. ! Item was added: + ----- Method: FileKernel>>linearRelativeTo: (in category 'accessing') ----- + linearRelativeTo: aDirectoryOrFile + | tmp | + self full = aDirectoryOrFile full ifTrue: [ ^ Directory new: '' ]. + + tmp := (self parent linearRelativeTo: aDirectoryOrFile) / self fileName. + + ^tmp + ! Item was added: + ----- Method: FileKernel>>asUrl (in category 'coercing') ----- + asUrl + + ^ executive toUrl: self! Item was added: + ----- Method: FileLocalExecutive class>>dynamic (in category 'accessing current') ----- + dynamic + + ^ Dynamic ifNil: [ Local ] + + ! Item was added: + ----- Method: FileKernel class>>fromString: (in category 'as yet unclassified') ----- + fromString: aPathString + + ^ self localExecutive newOfClass: self from: aPathString + ! Item was added: + ----- Method: FileKernel class>>localExecutive (in category 'as yet unclassified') ----- + localExecutive + + ^ FileLocalExecutive dynamic currentExecutive! Item was added: + ----- Method: FileNotification class>>currentExecutive (in category 'queries') ----- + currentExecutive + + ^ self new signal executive! Item was changed: ----- Method: FileLocalExecutive>>deleteFile: (in category 'executive actions') ----- + deleteFile: aFile - deleteFile: aRio - "Delete the file of the given name if it exists. If the first deletion attempt fails do a GC to force finalization of any lost references. ar 3/21/98 17:53" self retryWithGC: [ + self primDeleteFileNamed: aFile asVmPathName ] - self primDeleteFileNamed: aRio asVmPathName ] until:[:result| result notNil] + forFileNamed: aFile. - forFileNamed: aRio. + aFile statIsNowInvalid! - aRio statIsNowInvalid! Item was added: + ----- Method: FileKernel>>as: (in category 'comparison+legacy enabling') ----- + as: someOtherClass + + ^ someOtherClass basicNew copyFrom: self + ! Item was added: + ----- Method: FileExecutive>>print:on: (in category 'printing') ----- + print: aFileKernel on: str + + str << '(''' << aFileKernel asUrl asString << ((aFileKernel isKindOf: (self class dirClass)) ifFalse:[ ''' asFile)' ] ifTrue: [ ''' asDirectory)' ])! Item was changed: ----- Method: FileKernel class>>new (in category 'as yet unclassified') ----- new + ^ self error: 'use new:'! - ^ self new: '' ! Item was added: + ----- Method: FileKernel>>fileStream (in category 'public file') ----- + fileStream + + ^ FileStream concreteStream new + lineEndConvention: lineEndConvention + yourself ! Item was changed: ----- Method: FileExecutive>>basicWriter: (in category 'as yet unclassified') ----- + basicWriter: aFile + aFile statIsNowInvalid. - basicWriter: aRio - aRio statIsNowInvalid. + ^ aFile fileStream open: aFile forWrite: true - ^ self class fileStreamClass new open: aRio forWrite: true ! Item was added: + ----- Method: FileLocalExecutive>>in:select: (in category 'fs migration') ----- + in: aDir select: selectBlock + + ^ self in: aDir excluding: #('.DS_Store' '__MACOSX') select: selectBlock + ! Item was changed: ----- Method: FileKernel class>>thisImage (in category 'as yet unclassified') ----- thisImage + ^ self localExecutive getImageFile! - ^ self new: self defaultExecutive current primImagePath.! Item was changed: ----- Method: FileLocalExecutive class>>performStartUpMigration (in category 'image start up ') ----- performStartUpMigration | old | + old := Local. + Local := self newForThisPlatform initializeDefault. - old := self current. - Current := self newForThisPlatform. - Current initializeDefault. + old migrateFileSystemTo: Local.! - old migrateFileSystemTo: Current! Item was changed: Object subclass: #FileKernel + instanceVariableNames: 'executive value stat lineEndConvention' - instanceVariableNames: 'executive value stat' classVariableNames: 'TestFileSystem' poolDictionaries: '' category: 'File-Kernel'! + !FileKernel commentStamp: 'kph 3/1/2009 00:13' prior: 0! + The minimum File/Directory functionality required to support a kernel image + is implemented here, thus making File-Base etc unloadable. - !FileKernel commentStamp: 'kph 11/2/2008 22:50' prior: 0! - The minimum Rio functionality required to support a kernel image - is implemented here, thus making the rest of rio unloadable. + Local file instanciation in File-Base is 'file' asFile, however asFIle/asDirectory are not included in File-Kernel in order to avoid stepping upon other packages, and for simplicity. To instanciate a local file or directory reference, FileKernel new: aString, is "the" way. - Recursive querying via #select: is available however the selectBlock is passed a raw entryArray, rather than a RioStat instance. This is not intended to be used extensively but is needed as a minimum for #isFile/#isDirectory. If either #reader or #writer should fail RioKernel returns a nil, A functionally complete interface to the parts of the fileName is available as follows: getter - splitToBaseVersionAndExt: [ :b :v :e | ] setter - #base: <nil or newName> version: <nil or newVersion> ext: <nil or new ext> Interface for file versions is available via: #versions - returns a SortedCollection of the version numbers available for this rio #latestVersion - returns a rio for the latest version of the current rio in the versions list #nextVersion - returns a rio for the latest + 1 version of the current rio. Rio's may be included in the concatenation of strings RioKernel file copyTo: does a binary stream to stream copy, without a progress bar. Rio's file copyTo: honours the setting of the Rio's binary mode, and displays a progress bar. instVars --------- value - internal (to Rio) holds the path! Item was added: + ----- Method: FileExecutive>>checkVoted: (in category 'instanciation') ----- + checkVoted: voted + + "alternative local executives may override this to rig the voting" + + ^ voted + + ! Item was changed: ----- Method: FileKernel>>printOn: (in category 'printing') ----- printOn: str + self executive print: self on: str! - str << $( << self class name << ' new: ''' << value << ''')' - - ! Item was changed: ----- Method: FileKernel>>/ (in category 'as yet unclassified') ----- / morePath + ^ self copy pathJoin: morePath! - ^ self newFrom: (self pathJoin: morePath)! Item was added: + ----- Method: FileLocalExecutive class>>platformName (in category 'image start up ') ----- + platformName + + ^ SmalltalkImage current platformName asLegalSelector capitalized! Item was added: + ----- Method: FileLocalExecutive>>startAt:recursively:select:excluding:into: (in category 'executive actions') ----- + startAt: aDir recursively: beRecursive select: selectBlock excluding: xList into: results + + "Return a collection of rio's selected by passing + the directoryEntry array to the selectBlock. + + The KernelRio implemetation of setStatFromEntryArray: + does not populate these rios with stat data. + Rio's more verbose implementation does. + + This can be called with startAt: aString, but if so beRecursive must be false. + + See primLookupEntryIn:index: for further details." + + | index entryArray entry isDir fName | + + index := 1. + + [ (entryArray := self primLookupEntryIn: aDir asVmPathName index: index) notNil ] + whileTrue: [ + #badDirectoryPath = entryArray ifTrue: [ + ^ results "(InvalidDirectoryError pathName: aDir value) signal" ]. + + isDir := entryArray at: 4. + fName := entryArray at: 1. + + (xList includes: fName) ifFalse: [ + entry := ((isDir ifTrue: [ self class dirClass ] ifFalse: [ self class fileClass ]) + executive: self value: aDir asString) + pathJoin: fName; + setStatFromDir: aDir andEntryArray:entryArray; + yourself. + + (selectBlock value: entry) ifTrue: [ results add: entry ]. + + (beRecursive and: [ isDir ]) + ifTrue: [ + self + startAt: entry + recursively: beRecursive + select: selectBlock + excluding: xList + into: results + ]. + ]. + index := index + 1 + ]. + + ^ results! Item was added: + ----- Method: FileLocalExecutive>>newDirectoryFrom: (in category 'accessing') ----- + newDirectoryFrom: aPath! Item was changed: ----- Method: FileLocalExecutive class>>makeNew:from: (in category 'as yet unclassified') ----- makeNew: aClass from: path | str | str := (path beginsWith: 'file:///') ifTrue: [ (path allButFirst: 7) unescapePercents ] ifFalse: [ path ]. + ^ aClass executive: aClass localExecutive value: str ! - ^ aClass executive: self current value: str ! Item was added: + ----- Method: FileLocalDosExecutive>>lineEndConvention (in category 'as yet unclassified') ----- + lineEndConvention + + ^ #crlf! Item was changed: Notification subclass: #FileNotification + instanceVariableNames: 'isOverwrite executive' - instanceVariableNames: 'isOverwrite' classVariableNames: '' poolDictionaries: '' category: 'File-Kernel'! Item was changed: ----- Method: FileKernel>>parent (in category 'accessing') ----- parent "note that the parent of root is the file system 'executive' " ^self isRoot ifTrue: [ executive ] + ifFalse: [ executive class dirClass executive: executive value: self full path ] - ifFalse: [ executive dirClass executive: executive value: self full path ] ! Item was changed: ----- Method: FileLocalExecutive class>>newForThisPlatform (in category 'image start up ') ----- newForThisPlatform + ^ self perform: ('newFor', self platformName) asSymbol! - ^ self perform: ('newFor', self platform) asSymbol! Item was added: + ----- Method: FileExecutive>>in:excluding:select: (in category 'as yet unclassified') ----- + in: aDir excluding: xList select: selectBlock + + ^ self + startAt: aDir + recursively: aDir isRecursive + select: selectBlock + excluding: xList + into: (OrderedCollection new: 10) + ! Item was added: + ----- Method: FileNotification>>executive: (in category 'accessing') ----- + executive: anObject + + executive := anObject. + self resume: self.! Item was changed: ----- Method: FileKernel>>select: (in category 'enumeration') ----- select: selectBlock "select: returns an empty result if the rio is not a valid directory." + ^ executive in: self select: selectBlock! - ^ executive in: self select: selectBlock! Item was added: + ----- Method: FileLocalExecutive>>lineEndConvention (in category 'executive actions') ----- + lineEndConvention + + ^ #lf! Item was added: + ----- Method: Object>>isFileOrDirectory (in category '*file-kernel') ----- + isFileOrDirectory + + ^ false! Item was changed: ----- Method: FileLocalExecutive>>untrustedDirectory (in category 'executive actions') ----- untrustedDirectory + ^ self class dirClass new: (SecurityManager default primUntrustedUserDirectory) - ^ self dirClass new: (SecurityManager default primUntrustedUserDirectory) ! Item was added: + ----- Method: FileExecutive class>>classForPath: (in category 'as yet unclassified') ----- + classForPath: aPath + + | executiveClass winner priority | + + winner := 0. + executiveClass := nil. + + FileExecutive allSubclassesDo: [ :c | + priority := c canInstanciateFrom: aPath. + priority > winner ifTrue: [ winner := priority. + executiveClass := c ] ]. + + ^ executiveClass ! Item was added: + ----- Method: FileLocalExecutive>>pretendDuring: (in category 'pretending') ----- + pretendDuring: aBlock + + "In rare circumstances we want to handle a list of dos paths while in fact we are a unix box, + lets say we were compiling a script to be remotely distributed to DOS box. + + This technique also helps with testing various filesystems. + + We pop the notification in to the Dynamic slot, the only call it knows is #currentExecutive + Within the block, a call to currentExecutive, signals, and returns self. + + We 'ensure:' everything returns to normal when the block exits, if you need to do this + manually, then FileNotification will return fixedExecutive currentExecutive by default. + + " + + | tmp | + + [ + tmp := Dynamic. + Dynamic := FileNotification. + + [ aBlock value ] on: FileNotification do: [ :ex | ex executive: self ] + + ] ensure: [ Dynamic := tmp ]! Item was changed: ----- Method: FileLocalExecutive>>maxFileNameLength (in category 'misc') ----- maxFileNameLength ^ (self class respondsTo: #maxFileNameLength) ifTrue: [ self class maxFileNameLength ] + ifFalse: [ self class perform: ('maxFileNameLengthOn', self class platformName) asSymbol ]! - ifFalse: [ self class perform: ('maxFileNameLengthOn', self class platform) asSymbol ]! Item was added: + ----- Method: FileNotification class>>isOverwrite (in category 'queries') ----- + isOverwrite + + ^ self new signal isOverwrite! Item was changed: ----- Method: FileExecutive>>dir:mkpath:relativeTo: (in category 'as yet unclassified') ----- dir: aDir mkpath: aFileOrDir relativeTo: aBaseDirectory | newFD | + newFD := aBaseDirectory ifNil: [ aDir / aFileOrDir fileName ] - newFD := aBaseDirectory ifNil: [ (aDir / aFileOrDir fileName) asFile ] ifNotNil: [ aDir / (aFileOrDir linearRelativeTo: aBaseDirectory) ]. aFileOrDir isDirectory ifTrue: [ newFD mkpath ]. aFileOrDir isFile ifTrue: [ newFD parent mkpath ]. ^ newFD! Item was changed: ----- Method: FileExecutive>>in:select: (in category 'as yet unclassified') ----- in: aDir select: selectBlock + ^ self in: aDir excluding: #() select: selectBlock - ^ self - startAt: aDir - recursively: aDir isRecursive - select: selectBlock - into: (OrderedCollection new: 50) ! Item was changed: ----- Method: FileLocalExecutive>>getTempDirectory (in category 'executive actions') ----- getTempDirectory + ^ self class dirClass new: '/tmp'! - ^ self dirClass new: '/tmp'! Item was changed: ----- Method: FileLocalExecutive>>tempDirectory (in category 'executive actions') ----- tempDirectory + ^ self class dirClass new: '/tmp'! - ^ self dirClass new: '/tmp'! Item was added: + ----- Method: FileKernel>>split (in category 'private') ----- + split + + | parent | + + self value isEmpty ifTrue: [ ^ Array new ]. + + self splitToPathAndName: [ :p :n | + parent := self newFrom: p. + + (parent = self) ifTrue: [ ^ Array with: (self value allButLast) ]. + + ^ parent split copyWith: n + ] + ! Item was added: + ----- Method: FileLocalExecutive>>getImageFile (in category 'executive actions') ----- + getImageFile + + ^ self class fileClass executive: self value: self primImagePath! Item was added: + ----- Method: FileExecutive>>currentExecutive (in category 'case-sensitivity') ----- + currentExecutive + + "Dont call this, instead call, FileExecutive dynamic currentExecutive" + + ^ self + + ! Item was changed: ----- Method: FileKernel>>pathJoin: (in category 'private') ----- pathJoin: morePath + value := (executive isRoot: value) + ifTrue: [ value , morePath asString ] + ifFalse: [ value isEmpty + ifTrue: [ morePath asString ] + ifFalse: [ self value, '/', morePath asString ]] - (executive isRoot: value) ifTrue: [ ^ value , morePath asString ]. - - ^value isEmpty ifTrue: [ morePath asString ] - ifFalse: [ self value, executive pathDelimiter, morePath asString ]. ! Item was added: + ----- Method: FileKernel>>isFileOrDirectory (in category 'testing') ----- + isFileOrDirectory + + ^true! Item was changed: ----- Method: FileLocalDosExecutive class>>canInstanciateFrom: (in category 'as yet unclassified') ----- canInstanciateFrom: aString + ^ (#( 'file:///#:*' '#:*' 'file:///#%3A*') anySatisfy: [ :m | m match: aString ]) ifTrue: [ 100 ] ifFalse: [ 0 ] - ^ (('file:///#:*' match: aString) or: [ '#:*' match: aString ]) ifTrue: [ 100 ] ifFalse: [ 0 ] ! Item was added: + ----- Method: FileKernel>>lineEndConvention: (in category 'file copy') ----- + lineEndConvention: aSymbol + lineEndConvention := aSymbol! Item was removed: - ----- Method: FileKernel class>>newFileFrom: (in category 'as yet unclassified') ----- - newFileFrom: aPath - - ^ self defaultExecutive current class newFileFrom: aPath! Item was removed: - ----- Method: FileExecutive class>>newDirectoryFrom: (in category 'as yet unclassified') ----- - newDirectoryFrom: aString - - ^ (self instanciatorFrom: aString) makeNew: self dirClass from: aString - ! Item was removed: - ----- Method: FileLocalDosExecutive class>>instanciatorFrom: (in category 'as yet unclassified') ----- - instanciatorFrom: aString - - "we being a dos file system have been asked to instancate a url, if that returns a FileLocalExecutive - we butt in" - - ^ (super instanciatorFrom: aString)! Item was removed: - ----- Method: FileKernel class>>fileStreamClass (in category 'as yet unclassified') ----- - fileStreamClass - - ^ FileStream concreteStream! Item was removed: - ----- Method: FileLocalExecutive class>>platform (in category 'image start up ') ----- - platform - - ^ SmalltalkImage current platformName asLegalSelector capitalized! Item was removed: - ----- Method: String>>asFile (in category '*file-kernel') ----- - asFile - - ^ FileKernel newFileFrom: self! Item was removed: - ----- Method: FileExecutive class>>instanciatorFrom: (in category 'as yet unclassified') ----- - instanciatorFrom: aString - - | executiveClass winner priority | - - winner := 0. - - self instanciatorBase allSubclassesDo: [ :c | - priority := c canInstanciateFrom: aString. - priority > winner ifTrue: [ winner := priority. - executiveClass := c ] ]. - - ^ executiveClass ifNil: [ self default ]! Item was removed: - ----- Method: FileExecutive>>dirClass (in category 'as yet unclassified') ----- - dirClass - - ^ Smalltalk at: #Directory ifAbsent: [ FileKernel ]! Item was removed: - ----- Method: FileKernel class>>newDirectoryFrom: (in category 'as yet unclassified') ----- - newDirectoryFrom: aPath - - ^ self defaultExecutive current class newDirectoryFrom: aPath! Item was removed: - ----- Method: FileKernel>>isFileKernel (in category 'testing') ----- - isFileKernel - - ^true! Item was removed: - ----- Method: FileExecutive class>>default (in category 'as yet unclassified') ----- - default - - ^ FileLocalExecutive ! Item was removed: - ----- Method: FileLocalExecutive>>startAt:recursively:select:into: (in category 'executive actions') ----- - startAt: aDir recursively: beRecursive select: selectBlock into: results - - "Return a collection of rio's selected by passing - the directoryEntry array to the selectBlock. - - The KernelRio implemetation of setStatFromEntryArray: - does not populate these rios with stat data. - Rio's more verbose implementation does. - - This can be called with startAt: aString, but if so beRecursive must be false. - - See primLookupEntryIn:index: for further details." - - | index entryArray entry isDir fName | - - index := 1. - - [ (entryArray := self primLookupEntryIn: aDir asVmPathName index: index) notNil ] - whileTrue: [ - #badDirectoryPath = entryArray ifTrue: [ - ^ results "(InvalidDirectoryError pathName: aDir value) signal" ]. - - isDir := entryArray at: 4. - fName := entryArray at: 1. - - fName ~= '__MACOSX' ifTrue: [ - (entry := aDir / fName) - setStatFromDir: aDir andEntryArray:entryArray. - - isDir ifFalse: [ entry := entry asFile ]. - - (selectBlock value: entry) ifTrue: [ results add: entry ]. - - (beRecursive and: [ isDir ]) - ifTrue: [ - self - startAt: entry - recursively: beRecursive - select: selectBlock - into: results - ]. - ]. - index := index + 1 - ]. - - ^ results! Item was removed: - ----- Method: FileLocalExecutive class>>current (in category 'accessing current') ----- - current - - ^ Test ifNil: [ Current ] - - ! Item was removed: - ----- Method: FileKernel>>isFileKernelInstance (in category 'testing') ----- - isFileKernelInstance - - ^true! Item was removed: - ----- Method: String>>asDirectory (in category '*file-kernel') ----- - asDirectory - - ^ FileKernel newDirectoryFrom: self! Item was removed: - ----- Method: FileKernel class>>defaultExecutive (in category 'as yet unclassified') ----- - defaultExecutive - - ^ FileExecutive default! Item was removed: - ----- Method: FileExecutive class>>instanciatorBase (in category 'as yet unclassified') ----- - instanciatorBase - - ^ FileExecutive! Item was removed: - ----- Method: FileLocalExecutive class>>testEnd (in category 'image start up ') ----- - testEnd - - Test := nil! Item was removed: - ----- Method: FileExecutive class>>newFileFrom: (in category 'as yet unclassified') ----- - newFileFrom: aString - - ^ (self instanciatorFrom: aString) makeNew: self fileClass from: aString - ! Item was removed: - ----- Method: FileLocalExecutive class>>testFileSystem: (in category 'image start up ') ----- - testFileSystem: fs - - ^ Test := fs!

1 0

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

Packages March 2009