[Pkg] Rio: File-Kernel-kph.16.mcz
squeak-dev-noreply at lists.squeakfoundation.org
squeak-dev-noreply at lists.squeakfoundation.org
Mon Mar 2 20:35:47 UTC 2009
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!
More information about the Packages
mailing list