[Pkg] Rio: File-Kernel-kph.1.mcz
squeak-dev-noreply at lists.squeakfoundation.org
squeak-dev-noreply at lists.squeakfoundation.org
Thu Nov 13 02:18:56 UTC 2008
A new version of File-Kernel was added to project Rio:
http://www.squeaksource.com/Rio/File-Kernel-kph.1.mcz
==================== Summary ====================
Name: File-Kernel-kph.1
Author: kph
Time: 13 November 2008, 2:18:54 am
UUID: 48277d4e-9c33-4715-930d-51a96bc99cc0
Ancestors:
first release of File version of Rio
==================== Snapshot ====================
SystemOrganization addCategory: #'File-Kernel'!
----- Method: StandardFileStream class>>retryWithGC:until:forFileNamed: (in category '*file-kernel-override') -----
retryWithGC: execBlock until: testBlock forFileNamed: fullName
"Re-implemented to only force GC if a file with the given name exists"
| blockValue foundIt |
blockValue := execBlock value.
(testBlock value: blockValue) ifTrue:[^blockValue].
"See if we have a file with the given name"
foundIt := Registry keys "hold on strongly for now"
anySatisfy:[:file| file name sameAs: fullName asString ].
foundIt ifFalse:[^blockValue].
Smalltalk garbageCollectMost.
blockValue := execBlock value.
(testBlock value: blockValue) ifTrue:[^blockValue].
Smalltalk garbageCollect.
^execBlock value.!
----- Method: StandardFileStream>>close (in category '*file-kernel-override') -----
close
"Close this file."
fileID ifNotNil: [
self primClose: fileID.
self unregister.
fileID := nil].
^ name
!
----- Method: SocketStream>>copyTo: (in category '*file-kernel') -----
copyTo: out
self isBinary ifTrue: [ out binary ].
[self atEnd] whileFalse:
[ self receiveAvailableData.
out nextPutAll: self nextAllInBuffer.
].
!
----- Method: SocketStream>>copyTo:size:withProgress: (in category '*file-kernel') -----
copyTo: out size: size withProgress: label
| barPos read |
self isBinary ifTrue: [ out binary ].
label asString displayProgressAt: Sensor cursorPoint
from: (barPos := 0) to: size
during: [:bar |
[self atEnd] whileFalse:
[
bar value: barPos.
self receiveAvailableData.
out nextPutAll: (read := self nextAllInBuffer).
barPos := barPos + read size
].
].!
----- Method: String>>asDirectory (in category '*file-kernel') -----
asDirectory
^ FileKernel newDirectoryFrom: self!
----- Method: String>>asFile (in category '*file-kernel') -----
asFile
^ FileKernel newFileFrom: self!
Object subclass: #FileDirStat
instanceVariableNames: 'array dir'
classVariableNames: ''
poolDictionaries: ''
category: 'File-Kernel'!
!FileDirStat commentStamp: 'kph 3/8/2007 02:52' prior: 0!
A RioDirEntry is a wrapper for the results of primLookup to be more user friendly. For example modification times are avalable as squeak DateAndTime instances.
!
----- Method: FileDirStat class>>in:array: (in category 'as yet unclassified') -----
in: dirRio array: theArray
^ self new setDir: dirRio array: theArray!
----- Method: FileDirStat>>cTime (in category 'as yet unclassified') -----
cTime
^ TimeStamp fromSeconds: self cTimeInSeconds!
----- Method: FileDirStat>>cTimeInSeconds (in category 'as yet unclassified') -----
cTimeInSeconds
^ array at: 2!
----- Method: FileDirStat>>creationTime (in category 'as yet unclassified') -----
creationTime
^ self cTime!
----- Method: FileDirStat>>dir (in category 'as yet unclassified') -----
dir
^ dir!
----- Method: FileDirStat>>fileName (in category 'as yet unclassified') -----
fileName
^array at: 1!
----- Method: FileDirStat>>fileSize (in category 'as yet unclassified') -----
fileSize
^ array at: 5!
----- Method: FileDirStat>>invalidate (in category 'as yet unclassified') -----
invalidate
array := nil.!
----- Method: FileDirStat>>isDirectory (in category 'as yet unclassified') -----
isDirectory
^(array at: 4)!
----- Method: FileDirStat>>isFile (in category 'as yet unclassified') -----
isFile
^self isDirectory not!
----- Method: FileDirStat>>isInvalid (in category 'as yet unclassified') -----
isInvalid
^ dir isNil!
----- Method: FileDirStat>>isValid (in category 'as yet unclassified') -----
isValid
^ dir notNil!
----- Method: FileDirStat>>mTime (in category 'as yet unclassified') -----
mTime
^ TimeStamp fromSeconds: self mTimeInSeconds
!
----- Method: FileDirStat>>mTimeInSeconds (in category 'as yet unclassified') -----
mTimeInSeconds
^ array at: 3!
----- Method: FileDirStat>>modificationTime (in category 'as yet unclassified') -----
modificationTime
^ self mTime!
----- Method: FileDirStat>>rio (in category 'as yet unclassified') -----
rio
^ dir / self fileName!
----- Method: FileDirStat>>setDir:array: (in category 'as yet unclassified') -----
setDir: aDir array: data
dir := aDir.
array := data.!
Object subclass: #FileExecutive
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'File-Kernel'!
----- Method: FileExecutive class>>canInstanciateFrom: (in category 'as yet unclassified') -----
canInstanciateFrom: aPathString
"we return false, because we do not support any specific protocol"
^ false!
----- Method: FileExecutive class>>default (in category 'as yet unclassified') -----
default
^ FileLocalExecutive !
----- Method: FileExecutive class>>dirClass (in category 'as yet unclassified') -----
dirClass
^ Smalltalk at: #Directory ifAbsent: [ FileKernel ]!
----- Method: FileExecutive class>>fileClass (in category 'as yet unclassified') -----
fileClass
^ Smalltalk at: #File ifAbsent: [ FileKernel ]!
----- Method: FileExecutive class>>fileStreamClass (in category 'as yet unclassified') -----
fileStreamClass
^ FileStream concreteStream!
----- Method: FileExecutive class>>instanciatorFrom: (in category 'as yet unclassified') -----
instanciatorFrom: aString
| executiveClass |
FileExecutive allSubclassesDo: [ :c | (c canInstanciateFrom: aString) ifTrue: [ executiveClass := c ]].
^ executiveClass ifNil: [ self default ]!
----- Method: FileExecutive class>>newDirectoryFrom: (in category 'as yet unclassified') -----
newDirectoryFrom: aString
^ (self instanciatorFrom: aString) makeNew: self dirClass from: aString
!
----- Method: FileExecutive class>>newFileFrom: (in category 'as yet unclassified') -----
newFileFrom: aString
^ (self instanciatorFrom: aString) makeNew: self fileClass from: aString
!
----- Method: FileExecutive class>>pathDelimiter (in category 'as yet unclassified') -----
pathDelimiter
^ '/'
!
----- Method: FileExecutive>>MCPasswordManager (in category 'case-sensitivity') -----
MCPasswordManager
^ MCPasswordManager!
----- Method: FileExecutive>>arePathsCaseSensitive (in category 'case-sensitivity') -----
arePathsCaseSensitive
^ (self is: $a sameAs: $A) not
!
----- Method: FileExecutive>>basicReader: (in category 'as yet unclassified') -----
basicReader: aFile
^ self class fileStreamClass new open: aFile forWrite: false!
----- Method: FileExecutive>>basicWriter: (in category 'as yet unclassified') -----
basicWriter: aRio
^ self class fileStreamClass new open: aRio forWrite: true
!
----- Method: FileExecutive>>delete: (in category 'as yet unclassified') -----
delete: aFileOrDir
aFileOrDir isDirectory ifTrue: [ ^ aFileOrDir rmdir ].
self deleteFile: aFileOrDir.!
----- Method: FileExecutive>>dirClass (in category 'as yet unclassified') -----
dirClass
^ Smalltalk at: #Directory ifAbsent: [ FileKernel ]!
----- Method: FileExecutive>>fileClass (in category 'as yet unclassified') -----
fileClass
^ Smalltalk at: #File ifAbsent: [ FileKernel ]!
----- Method: FileExecutive>>fileSize: (in category 'testing') -----
fileSize: aRio
^ aRio stat fileSize!
----- Method: FileExecutive>>fullFor: (in category 'as yet unclassified') -----
fullFor: aFileOrDirectory
"the absolute path of this rio, or if relative
combine with #defaultDirectory to obtain the full path"
aFileOrDirectory value isEmpty ifTrue: [ ^ self defaultDirectory ].
(self isFull: aFileOrDirectory) ifTrue: [ ^ aFileOrDirectory ].
^ aFileOrDirectory newFrom: (self defaultDirectory value, self pathDelimiter, aFileOrDirectory value)!
----- Method: FileExecutive>>hashFor: (in category 'equality') -----
hashFor: aRio
^ aRio value hash!
----- Method: FileExecutive>>importValue: (in category 'executive actions') -----
importValue: path
path isEmpty ifTrue: [ ^ '' ].
(self isRoot: path) ifTrue: [ ^ self rootString ].
(path last = self pathDelimiter first) ifTrue: [ ^ path allButLast ].
^path!
----- Method: FileExecutive>>in:select: (in category 'as yet unclassified') -----
in: aDir select: selectBlock
^ self
startAt: aDir
recursively: aDir isRecursive
select: selectBlock
into: (OrderedCollection new: 50)
!
----- Method: FileExecutive>>is:sameAs: (in category 'equality') -----
is: aRio sameAs: bRio
^ aRio value = bRio value!
----- Method: FileExecutive>>isDirectory: (in category 'as yet unclassified') -----
isDirectory: aRio
^ aRio stat ifNil: [ false ] ifNotNil: [ aRio stat isDirectory ]
!
----- Method: FileExecutive>>isFile: (in category 'as yet unclassified') -----
isFile: aFileOrDirectory
^ (aFileOrDirectory stat ifNil: [ ^ false ]) isFile
!
----- Method: FileExecutive>>isFull: (in category 'as yet unclassified') -----
isFull: aFileOrDirectory
^ aFileOrDirectory value beginsWith: self rootString!
----- Method: FileExecutive>>isRoot: (in category 'testing') -----
isRoot: aRioOrString
^ aRioOrString value = self rootString!
----- Method: FileExecutive>>makeNewRioFromString: (in category 'as yet unclassified') -----
makeNewRioFromString: aString
^ self fileClass executive: self value: aString !
----- Method: FileExecutive>>mkdir: (in category 'as yet unclassified') -----
mkdir: aRio
aRio isDirectory ifTrue: [ ^ self error: 'directory already exists' ].
self createDirectory: aRio !
----- Method: FileExecutive>>mkpath: (in category 'as yet unclassified') -----
mkpath: aRio
aRio isDirectory ifTrue: [ ^self ].
aRio parent mkpath.
self createDirectory: aRio. !
----- Method: FileExecutive>>pathDelimiter (in category 'as yet unclassified') -----
pathDelimiter
^ '/'
!
----- Method: FileExecutive>>pathDelimiterChar (in category 'as yet unclassified') -----
pathDelimiterChar
^ $/
!
----- Method: FileExecutive>>root (in category 'as yet unclassified') -----
root
^ self class makeNew: self class dirClass from: self rootString!
----- Method: FileExecutive>>rootString (in category 'as yet unclassified') -----
rootString
^ self subclassResponsibility!
----- Method: FileExecutive>>touch: (in category 'as yet unclassified') -----
touch: aRio
aRio writer close!
FileExecutive subclass: #FileLocalExecutive
instanceVariableNames: 'rootString root defaultDirectory'
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)
!
FileLocalExecutive subclass: #FileLocalCaseInsensitiveExecutive
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'File-Kernel'!
----- Method: FileLocalCaseInsensitiveExecutive>>hashFor: (in category 'case-sensitivity') -----
hashFor: aRio
^ aRio value asLowercase hash!
----- Method: FileLocalCaseInsensitiveExecutive>>is:sameAs: (in category 'case-sensitivity') -----
is: aRio sameAs: bRio
^ (aRio value compare: bRio value caseSensitive: false) = 2!
FileLocalCaseInsensitiveExecutive subclass: #FileLocalDosExecutive
instanceVariableNames: ''
classVariableNames: 'Volumes'
poolDictionaries: ''
category: 'File-Kernel'!
!FileLocalDosExecutive commentStamp: 'kph 4/17/2007 19:19' prior: 0!
The initial idea was to model things properly as a file within a named volume, on unix there would be one executive for the whole system. On dos there would be one executive per volume.!
----- Method: FileLocalDosExecutive class>>canInstanciateFrom: (in category 'as yet unclassified') -----
canInstanciateFrom: aString
^ (aString size > 1 and: [ aString second = $: ])!
----- Method: FileLocalDosExecutive class>>executiveForVolume: (in category 'as yet unclassified') -----
executiveForVolume: theRequestedRoot
| requestedRoot |
requestedRoot := theRequestedRoot.
requestedRoot = nil ifTrue: [ requestedRoot := 'C:/' ].
^ Volumes
detect: [ :i | i isRoot: requestedRoot ]
ifNone: [ Volumes add: (self class basicNew setRootString: requestedRoot; setDefault: nil; yourself) ]!
----- Method: FileLocalDosExecutive class>>initializeVolumes (in category 'as yet unclassified') -----
initializeVolumes
Volumes := Set new !
----- Method: FileLocalDosExecutive class>>makeNew:from: (in category 'as yet unclassified') -----
makeNew: aClass from: str
| rioDrive exec |
rioDrive := nil.
(str size > 1) ifTrue: [
(str second = $:) ifTrue: [ rioDrive := (str first: 2) , self pathDelimiter ].
].
exec := self executiveForVolume: rioDrive.
^ aClass executive: exec value: str!
----- Method: FileLocalDosExecutive class>>pathDelimiter (in category 'as yet unclassified') -----
pathDelimiter
^ '\'
!
----- Method: FileLocalDosExecutive>>drive (in category 'accessing') -----
drive
^ self rootString first: 2!
----- Method: FileLocalDosExecutive>>driveLetter (in category 'accessing') -----
driveLetter
^ self rootString first!
----- Method: FileLocalDosExecutive>>executiveForVolume: (in category 'accessing') -----
executiveForVolume: requestedRoot
^ Volumes
detect: [ :i | i isRoot: requestedRoot ]
ifNone: [ Volumes add: (self class basicNew setRootString: requestedRoot; setDefault: nil; yourself) ]!
----- 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 #defaultDirectory to obtain the full path"
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: (self defaultDirectory value, self pathDelimiter, aRio value)!
----- Method: FileLocalDosExecutive>>getTempDirectory (in category 'as yet unclassified') -----
getTempDirectory
^ self dirClass new: 'C:\WINDOWS\TEMP\'!
----- Method: FileLocalDosExecutive>>importValue: (in category 'as yet unclassified') -----
importValue: aPath
^ super importValue: (aPath copy replaceAll: $/ with: $\).!
----- Method: FileLocalDosExecutive>>initializeDefault (in category 'as yet unclassified') -----
initializeDefault
self setRootString: (self primImagePath first: 3);
setDefault: self getDefaultDirectory.
Volumes add: self.!
----- Method: FileLocalDosExecutive>>isRoot: (in category 'as yet unclassified') -----
isRoot: aRioOrString
aRioOrString value size = self rootString size ifTrue: [ ^ super isRoot: aRioOrString ].
^ (aRioOrString value, self pathDelimiter) = self rootString!
----- Method: FileLocalDosExecutive>>makeNewFrom: (in category 'fs migration') -----
makeNewFrom: aString
| rioDrive exec str |
str := aString.
exec := self.
(aString size > 1) ifTrue: [
rioDrive := rootString.
(str second = $:) ifTrue: [ rioDrive := (str first: 2) , self pathDelimiter ].
rioDrive ~= rootString ifTrue: [ exec := self executiveForVolume: rioDrive ].
].
^ exec fileClass executive: exec value: str!
----- Method: FileLocalDosExecutive>>makeNewRioFrom: (in category 'fs migration') -----
makeNewRioFrom: aString
| rioDrive exec str |
str := aString.
exec := self.
(aString size > 1) ifTrue: [
rioDrive := rootString.
(str second = $:) ifTrue: [ rioDrive := (str first: 2) , self pathDelimiter ].
rioDrive ~= rootString ifTrue: [ exec := self executiveForVolume: rioDrive ].
].
^ exec fileClass executive: exec value: str!
----- Method: FileLocalDosExecutive>>migrateFromLocalDosFileSystem: (in category 'fs migration todo') -----
migrateFromLocalDosFileSystem: nfs
"could do something here"
^ nfs !
----- Method: FileLocalDosExecutive>>migrateFromLocalFileSystem: (in category 'fs migration') -----
migrateFromLocalFileSystem: nfs
^ self !
----- Method: FileLocalDosExecutive>>migrateToLocalDosFileSystem: (in category 'fs migration') -----
migrateToLocalDosFileSystem: old
^ self!
----- Method: FileLocalDosExecutive>>pathDelimiter (in category 'as yet unclassified') -----
pathDelimiter
^ '\'
!
----- Method: FileLocalDosExecutive>>pathDelimiterChar (in category 'as yet unclassified') -----
pathDelimiterChar
^ $\
!
----- Method: FileLocalExecutive class>>current (in category 'accessing current') -----
current
^ Test ifNil: [ Current ]
!
----- Method: FileLocalExecutive class>>initialize (in category 'class initialization') -----
initialize
Smalltalk addToStartUpList: self after: Delay.
FileLocalDosExecutive initializeVolumes.
Current := self newForThisPlatform.
Current initializeDefault.
!
----- Method: FileLocalExecutive class>>makeNew:from: (in category 'as yet unclassified') -----
makeNew: aClass from: aString
^ aClass executive: self current value: aString !
----- Method: FileLocalExecutive class>>maxFileNameLengthOnDOS (in category 'image start up ') -----
maxFileNameLengthOnDOS
^ 8!
----- Method: FileLocalExecutive class>>maxFileNameLengthOnMacOS (in category 'image start up ') -----
maxFileNameLengthOnMacOS
^ 31!
----- Method: FileLocalExecutive class>>maxFileNameLengthOnRiscOS (in category 'image start up ') -----
maxFileNameLengthOnRiscOS
^ 255!
----- Method: FileLocalExecutive class>>maxFileNameLengthOnUnix (in category 'image start up ') -----
maxFileNameLengthOnUnix
^ 255!
----- Method: FileLocalExecutive class>>maxFileNameLengthOnWin32 (in category 'image start up ') -----
maxFileNameLengthOnWin32
^ 255!
----- Method: FileLocalExecutive class>>newForDOS (in category 'image start up ') -----
newForDOS
^ FileLocalDosExecutive new!
----- Method: FileLocalExecutive class>>newForMacOS (in category 'image start up ') -----
newForMacOS
^ FileLocalCaseInsensitiveExecutive new!
----- Method: FileLocalExecutive class>>newForRiscOS (in category 'image start up ') -----
newForRiscOS
^ FileLocalExecutive new!
----- Method: FileLocalExecutive class>>newForThisPlatform (in category 'image start up ') -----
newForThisPlatform
^ self perform: ('newFor', self platform) asSymbol!
----- Method: FileLocalExecutive class>>newForUnix (in category 'image start up ') -----
newForUnix
^ FileLocalExecutive!
----- Method: FileLocalExecutive class>>newForWin32 (in category 'image start up ') -----
newForWin32
^ FileLocalDosExecutive!
----- Method: FileLocalExecutive class>>performStartUpMigration (in category 'image start up ') -----
performStartUpMigration
| old |
old := self current.
Current := self newForThisPlatform.
Current initializeDefault.
old migrateFileSystemTo: Current!
----- Method: FileLocalExecutive class>>platform (in category 'image start up ') -----
platform
^ SmalltalkImage current platformName asLegalSelector capitalized!
----- Method: FileLocalExecutive class>>startUp: (in category 'image start up ') -----
startUp: resuming
resuming ifFalse: [ ^self ].
self performStartUpMigration.!
----- Method: FileLocalExecutive class>>testEnd (in category 'image start up ') -----
testEnd
Test := nil!
----- Method: FileLocalExecutive class>>testFileSystem: (in category 'image start up ') -----
testFileSystem: fs
^ Test := fs!
----- Method: FileLocalExecutive>>createDirectory: (in category 'executive actions') -----
createDirectory: aRio
^ self primCreateDirectory: aRio asVmPathName !
----- Method: FileLocalExecutive>>defaultDirectory (in category 'accessing') -----
defaultDirectory
^ defaultDirectory!
----- Method: FileLocalExecutive>>deleteDirectory: (in category 'executive actions') -----
deleteDirectory: aDir
self primDeleteDirectory: aDir asVmPathName.
aDir statIsNowInvalid!
----- Method: FileLocalExecutive>>deleteFile: (in category 'executive actions') -----
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: aRio asVmPathName ]
until:[:result| result notNil]
forFileNamed: aRio.
aRio statIsNowInvalid!
----- Method: FileLocalExecutive>>errorMustBeInSameFileSystem: (in category 'errors') -----
errorMustBeInSameFileSystem: aDirectory
^ self error: 'Must be in same file system', aDirectory, ',', self printString!
----- Method: FileLocalExecutive>>errorUnableToDeleteDir: (in category 'errors') -----
errorUnableToDeleteDir: fullPath
| entries |
entries := fullPath asDirectory entries.
^ self error: 'unable to delete directory: ', fullPath, ((entries size >0) ifTrue: [' (not empty)'] ifFalse: ['']).
!
----- Method: FileLocalExecutive>>getDefaultDirectory (in category 'executive actions') -----
getDefaultDirectory
^ (Preferences startInUntrustedDirectory
ifTrue: [ self untrustedDirectory mkpath ]
ifFalse: [ self getImageDirectory ] )!
----- Method: FileLocalExecutive>>getImageDirectory (in category 'executive actions') -----
getImageDirectory
^ (self dirClass executive: self value: self primImagePath) parent !
----- Method: FileLocalExecutive>>getMacFileTypeAndCreator: (in category 'executive actions') -----
getMacFileTypeAndCreator: aRio
| results typeString creatorString |
"get the Macintosh file type and creator info for the file with the given name. Fails if the file does not exist or if the type and creator type arguments are not strings of length 4. Does nothing on other platforms (where the underlying primitive is a noop)."
"FileDirectory default getMacFileNamed: 'foo'"
typeString := ByteArray new: 4 withAll: ($? asInteger).
creatorString := ByteArray new: 4 withAll: ($? asInteger).
[self primGetMacFileNamed: aRio asVmPathName
type: typeString
creator: creatorString.] ensure:
[typeString := typeString asString.
creatorString := creatorString asString].
results := Array with: typeString convertFromSystemString with: creatorString convertFromSystemString.
^results
!
----- Method: FileLocalExecutive>>getTempDirectory (in category 'executive actions') -----
getTempDirectory
^ self dirClass new: '/tmp'!
----- Method: FileLocalExecutive>>initializeDefault (in category 'executive actions') -----
initializeDefault
self setRootString: self pathDelimiter;
setDefault: self getDefaultDirectory!
----- Method: FileLocalExecutive>>isDirectory: (in category 'executive actions') -----
isDirectory: aRio
^ #badDirectoryPath ~= (self primLookupEntryIn: aRio full value index: 1)
!
----- Method: FileLocalExecutive>>linearRelativeTo: (in category 'executive actions') -----
linearRelativeTo: aDirectory
self ~= aDirectory executive ifTrue: [ ^ self errorMustBeInSameFileSystem: aDirectory ].
^ self root!
----- Method: FileLocalExecutive>>maxFileNameLength (in category 'misc') -----
maxFileNameLength
^ (self class respondsTo: #maxFileNameLength)
ifTrue: [ self class maxFileNameLength ]
ifFalse: [ self class perform: ('maxFileNameLengthOn', self class platform) asSymbol ]!
----- Method: FileLocalExecutive>>migrateFileSystemTo: (in category 'fs migration') -----
migrateFileSystemTo: next
^ next migrateFromLocalFileSystem: self !
----- Method: FileLocalExecutive>>migrateFromLocalDosFileSystem: (in category 'fs migration') -----
migrateFromLocalDosFileSystem: nfs
"could do something here"
^ self !
----- Method: FileLocalExecutive>>migrateFromLocalFileSystem: (in category 'fs migration') -----
migrateFromLocalFileSystem: nfs
^ nfs !
----- Method: FileLocalExecutive>>primCreateDirectory: (in category 'primitives') -----
primCreateDirectory: fullPath
"Create a directory named by the given path. Fail if the path is bad or if a file or directory by that name already exists."
<primitive: 'primitiveDirectoryCreate' module: 'FilePlugin'>
self primitiveFailed!
----- Method: FileLocalExecutive>>primDeleteDirectory: (in category 'primitives') -----
primDeleteDirectory: fullPath
"Delete the directory named by the given path. Raise an error if the path is bad or if a directory by that name does not exist."
<primitive: 'primitiveDirectoryDelete' module: 'FilePlugin'>
^ self errorUnableToDeleteDir: fullPath
!
----- Method: FileLocalExecutive>>primDeleteFileNamed: (in category 'primitives') -----
primDeleteFileNamed: aFileName
"Delete the file of the given name. Return self if the primitive succeeds, nil otherwise."
<primitive: 'primitiveFileDelete' module: 'FilePlugin'>
^ nil
!
----- Method: FileLocalExecutive>>primGetMacFileNamed:type:creator: (in category 'primitives') -----
primGetMacFileNamed: fileName type: typeString creator: creatorString
"Get the Macintosh file type and creator info for the file with the given name. Fails if the file does not exist or if the type and creator type arguments are not strings of length 4. This primitive is Mac specific; it is a noop on other platforms."
<primitive: 'primitiveDirectoryGetMacTypeAndCreator' module: 'FilePlugin'>
!
----- Method: FileLocalExecutive>>primImagePath (in category 'primitives') -----
primImagePath
"Answer the full path name for the current image."
"self new primImagePath"
<primitive: 121>
self primitiveFailed!
----- Method: FileLocalExecutive>>primLookupEntryIn:index: (in category 'primitives') -----
primLookupEntryIn: fullPath index: index
"Look up the index-th entry of the directory with the given fully-qualified path (i.e., starting from the root of the file hierarchy) and return an array containing:
<name>
<creationTime in seconds since squeak epoch>
<modificationTime>
<dirFlag (dir is true)>
<fileSize in bytes>
The empty string enumerates the top-level files or drives. (For example, on Unix, the empty path enumerates the contents of '/'. On Macs and PCs, it enumerates the mounted volumes/drives.)
Returns nil when index is past the end of the directory.
Fails if the given path is bad."
<primitive: 'primitiveDirectoryLookup' module: 'FilePlugin'>
^ #badDirectoryPath
!
----- Method: FileLocalExecutive>>primPathNameDelimiter (in category 'primitives') -----
primPathNameDelimiter
"Return the path delimiter for the underlying platform's file system."
<primitive: 'primitiveDirectoryDelimitor' module: 'FilePlugin'>
self primitiveFailed
!
----- Method: FileLocalExecutive>>primRename:to: (in category 'primitives') -----
primRename: oldFileFullName to: newFileFullName
"Rename the file of the given name to the new name. Fail if there is no file of the old name or if there is an existing file with the new name.
Changed to return nil instead of failing ar 3/21/98 18:04"
<primitive: 'primitiveFileRename' module: 'FilePlugin'>
^nil!
----- Method: FileLocalExecutive>>primSetMacFileNamed:type:creator: (in category 'primitives') -----
primSetMacFileNamed: fileName type: typeString creator: creatorString
"Set the Macintosh file type and creator info for the file with the given name. Fails if the file does not exist or if the type and creator type arguments are not strings of length 4. This primitive is Mac specific; it is a noop on other platforms."
<primitive: 'primitiveDirectorySetMacTypeAndCreator' module: 'FilePlugin'>
self primitiveFailed
!
----- Method: FileLocalExecutive>>primVmPath (in category 'primitives') -----
primVmPath
"Answer the path for the directory containing the Smalltalk virtual machine. Return the empty string if this primitive is not implemented."
"Rio primVmPath"
<primitive: 142>
^ ''!
----- Method: FileLocalExecutive>>printId (in category 'printing') -----
printId
^ rootString!
----- Method: FileLocalExecutive>>printOn: (in category 'printing') -----
printOn: str
super printOn: str.
str nextPut: $(; nextPutAll: self printId; nextPut: $).!
----- 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].
bRio exists ifTrue:[ ^self error: 'Failed to rename, ', bRio,' already exists.' ].!
----- Method: FileLocalExecutive>>retryWithGC:until:forFileNamed: (in category 'utilities') -----
retryWithGC: execBlock until: okBlock forFileNamed: aRio
^ StandardFileStream
retryWithGC: execBlock
until: okBlock
forFileNamed: aRio!
----- Method: FileLocalExecutive>>rootString (in category 'accessing') -----
rootString
^ rootString!
----- Method: FileLocalExecutive>>set:macType:creator: (in category 'executive actions') -----
set: aRio macType: typeString creator: creatorString
"Set the Macintosh file type and creator info for the file with the given name. Fails if the file does not exist or if the type and creator type arguments are not strings of length 4."
self primSetMacFileNamed: aRio asVmPathName
type: typeString convertToSystemString
creator: creatorString convertToSystemString.!
----- Method: FileLocalExecutive>>setDefault: (in category 'executive actions') -----
setDefault: d
defaultDirectory := d!
----- Method: FileLocalExecutive>>setRootString: (in category 'executive actions') -----
setRootString: aString
rootString := aString.
!
----- 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 |
index := 1.
[ (entryArray := self primLookupEntryIn: aDir asVmPathName index: index) notNil ]
whileTrue: [
#badDirectoryPath = entryArray ifTrue: [
^ results "(InvalidDirectoryError pathName: aDir value) signal" ].
isDir := entryArray at: 4.
(entry := aDir / (entryArray at: 1))
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!
----- Method: FileLocalExecutive>>tempDirectory (in category 'executive actions') -----
tempDirectory
^ self dirClass new: '/tmp'!
----- Method: FileLocalExecutive>>untrustedDirectory (in category 'executive actions') -----
untrustedDirectory
^ self dirClass new: (SecurityManager default primUntrustedUserDirectory)
!
Object subclass: #FileKernel
instanceVariableNames: 'executive value stat'
classVariableNames: 'TestFileSystem'
poolDictionaries: ''
category: 'File-Kernel'!
!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.
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!
----- Method: FileKernel class>>defaultExecutive (in category 'as yet unclassified') -----
defaultExecutive
^ FileExecutive default!
----- Method: FileKernel class>>executive:value: (in category 'as yet unclassified') -----
executive: e value: v
^ self basicNew
setExecutive: e
value: v!
----- Method: FileKernel class>>fileStreamClass (in category 'as yet unclassified') -----
fileStreamClass
^ FileStream concreteStream!
----- Method: FileKernel class>>initialize (in category 'as yet unclassified') -----
initialize
TestFileSystem := nil!
----- Method: FileKernel class>>new (in category 'as yet unclassified') -----
new
^ self new: '' !
----- Method: FileKernel class>>new: (in category 'as yet unclassified') -----
new: aPathOrFile
"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!
----- Method: FileKernel class>>newDirectoryFrom: (in category 'as yet unclassified') -----
newDirectoryFrom: aPath
^ self defaultExecutive current class newDirectoryFrom: aPath!
----- Method: FileKernel class>>newFileFrom: (in category 'as yet unclassified') -----
newFileFrom: aPath
^ self defaultExecutive current class newFileFrom: aPath!
----- Method: FileKernel class>>thisImage (in category 'as yet unclassified') -----
thisImage
^ self new: self defaultExecutive current primImagePath.!
----- Method: FileKernel>>/ (in category 'as yet unclassified') -----
/ morePath
^ self newFrom: (self pathJoin: morePath)!
----- Method: FileKernel>>= (in category 'comparison+legacy enabling') -----
= aRioAble
^ executive is: self sameAs: aRioAble asFile!
----- Method: FileKernel>>asDirectory (in category 'coercing') -----
asDirectory
^ self!
----- Method: FileKernel>>asFile (in category 'coercing') -----
asFile
^ self!
----- Method: FileKernel>>asPath (in category 'coercing') -----
asPath
^ self!
----- Method: FileKernel>>asSqueakPathName (in category 'comparison+legacy enabling') -----
asSqueakPathName
"permits a rio to be handed right into open:forWrite:"
^ self full value!
----- Method: FileKernel>>asString (in category 'coercing') -----
asString
^ value!
----- Method: FileKernel>>asVmPathName (in category 'comparison+legacy enabling') -----
asVmPathName
"permits a rio to be handed right into open:forWrite:"
^ self full value !
----- Method: FileKernel>>at: (in category 'comparison+legacy enabling') -----
at: n
"this is purely to enable Rio's to be concatenated with strings"
^ self value at: n!
----- Method: FileKernel>>base:version:ext: (in category 'accessing') -----
base: newBase version: newVersion ext: newExt
"only changes non nil values"
| base version ext |
self splitToBaseVersionAndExt: [ :b :v :e |
base := newBase ifNil: [ b ].
version := newVersion ifNil: [ v ].
ext := newExt ifNil: [ e ].
].
self fileName:
(String streamContents: [ :str |
str nextPutAll: base.
version = 0 ifFalse: [
str nextPut: $. ; nextPutAll: version asString
].
ext notEmpty ifTrue: [
str nextPut: $.; nextPutAll: ext
]
]).
!
----- Method: FileKernel>>basicReader (in category 'public file') -----
basicReader
^ executive basicReader: self!
----- Method: FileKernel>>basicWriter (in category 'public file') -----
basicWriter
^ executive basicWriter: self!
----- Method: FileKernel>>copyTo: (in category 'file copy') -----
copyTo: aPathOrFile
| in out |
self validateIsFile.
(in := self reader) binary copyTo: (out := aPathOrFile asFile writer) binary.
out close.
in close.
^ aPathOrFile asFile
!
----- Method: FileKernel>>entries (in category 'enumeration') -----
entries
^ self select: [:e | true ]!
----- Method: FileKernel>>executive (in category 'accessing') -----
executive
^ executive !
----- Method: FileKernel>>executive: (in category 'accessing') -----
executive: aSystem
executive := aSystem!
----- Method: FileKernel>>exists (in category 'testing') -----
exists
^ self isDirectory or: [ self isFile ]!
----- Method: FileKernel>>fileName (in category 'accessing') -----
fileName
^ stat ifNotNil: [ stat fileName ] ifNil: [ self splitToPathAndName: [ :path :n | n ] ]
!
----- Method: FileKernel>>fileName: (in category 'accessing') -----
fileName: newFileName
self splitToPathAndName: [ :dirPath :fileName |
value := executive importValue: ((self newFrom: dirPath) pathJoin: newFileName) asString
].!
----- Method: FileKernel>>findTokens: (in category 'comparison+legacy enabling') -----
findTokens: t
"this method enables Rio to be passed into a MultiByteFileStream just as a string, it is not needed in 3.9+"
^ self asString findTokens: t!
----- Method: FileKernel>>full (in category 'accessing') -----
full
^ executive fullFor: self!
----- Method: FileKernel>>hash (in category 'as yet unclassified') -----
hash
^ executive hashFor: self!
----- Method: FileKernel>>isDirectory (in category 'testing') -----
isDirectory
^ executive isDirectory: self !
----- Method: FileKernel>>isEmpty (in category 'coercing') -----
isEmpty
^ value isEmpty!
----- Method: FileKernel>>isFile (in category 'testing') -----
isFile
^ executive isFile: self!
----- Method: FileKernel>>isFileKernel (in category 'testing') -----
isFileKernel
^true!
----- Method: FileKernel>>isFileKernelInstance (in category 'testing') -----
isFileKernelInstance
^true!
----- Method: FileKernel>>isRecursive (in category 'testing') -----
isRecursive
^ false!
----- Method: FileKernel>>isRoot (in category 'testing') -----
isRoot
^ executive isRoot: self!
----- Method: FileKernel>>latestVersion (in category 'versions') -----
latestVersion
^ self copy base: nil version: (self versions last) ext: nil!
----- Method: FileKernel>>newFrom: (in category 'as yet unclassified') -----
newFrom: pathOrFileOrDirectory
^ self class executive: executive value: pathOrFileOrDirectory!
----- Method: FileKernel>>nextVersion (in category 'versions') -----
nextVersion
"the next non-exisiting version (self if none)"
^ self copy base: nil version: ((self versions ifEmpty: [ ^ self ]) last + 1) ext: nil!
----- Method: FileKernel>>parent (in category 'accessing') -----
parent
"note that the parent of root is the file system 'executive' "
^self isRoot ifTrue: [ executive ]
ifFalse: [ executive dirClass executive: executive value: self full path ]
!
----- Method: FileKernel>>path (in category 'accessing') -----
path
^ self splitToPathAndName: [ :path :n | path ].!
----- Method: FileKernel>>pathJoin: (in category 'private') -----
pathJoin: morePath
(executive isRoot: value) ifTrue: [ ^ value , morePath asString ].
^value isEmpty ifTrue: [ morePath asString ]
ifFalse: [ self value, executive pathDelimiter, morePath asString ].
!
----- Method: FileKernel>>printOn: (in category 'printing') -----
printOn: str
str << $( << self class name << ' new: ''' << value << ''')'
!
----- Method: FileKernel>>reader (in category 'public file') -----
reader
^ self basicReader!
----- Method: FileKernel>>sameAs: (in category 'testing') -----
sameAs: aFileAble
^ executive is: self sameAs: aFileAble asFile!
----- 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!
----- Method: FileKernel>>setExecutive:value: (in category 'as yet unclassified') -----
setExecutive: e value: aRef
"create a fully initialized rio"
executive := e.
self value: aRef.
^ self !
----- Method: FileKernel>>setMacType:creator: (in category 'as yet unclassified') -----
setMacType: typeString creator: creatorString
"Set the Macintosh file type and creator info for the file with the given name. Fails if the file does not exist or if the type and creator type arguments are not strings of length 4."
executive set: self macType: typeString creator: creatorString!
----- Method: FileKernel>>setStatFromDir:andEntryArray: (in category 'accessing') -----
setStatFromDir: dir andEntryArray: a
stat := FileDirStat in: dir array: a
!
----- Method: FileKernel>>size (in category 'as yet unclassified') -----
size
"size returns the path length, this is to enable Rio's to be concatenated with strings"
^ self value size!
----- Method: FileKernel>>splitToBaseVersionAndExt: (in category 'accessing') -----
splitToBaseVersionAndExt: block
| fileName version ext period |
fileName := self fileName.
period := fileName lastIndexOf: $..
((period <=1) | (period = fileName size)) ifTrue: [ ^ block value: fileName value: 0 value: '' ].
ext := fileName copyFrom: (period + 1) to: fileName size.
fileName := fileName copyFrom: 1 to: period - 1.
period := fileName lastIndexOf: $. ifAbsent: [ ^ block value: fileName value: 0 value: ext ].
version := fileName copyFrom: period + 1 to: fileName size.
version do: [ :char | char isDigit ifFalse: [ ^ block value: fileName value: 0 value: ext ]].
version := version asInteger.
fileName := fileName copyFrom: 1 to: period - 1.
^ block value: fileName value: version value: ext
!
----- 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 |
fullName := self value.
i := fullName lastIndexOf: executive pathDelimiterChar.
i == 0 ifTrue: [ ^ pathAndNameBlock value: '' value: fullName ].
dirName := fullName copyFrom: 1 to: (i - 1 max: 1).
localName := fullName copyFrom: i + 1 to: fullName size.
^ pathAndNameBlock value: dirName value: localName!
----- Method: FileKernel>>stat (in category 'stat') -----
stat
| full |
(stat notNil and: [ stat isValid ]) ifTrue: [ ^ stat ].
full := self full.
(Directory executive: executive value: full path) select: [ :e |
e = full ifTrue: [ ^ stat ifNil: [ e stat ] ifNotNil: [ stat copyFrom: e stat. ] ].
false.
].
^ stat := nil.
!
----- Method: FileKernel>>statIsNowInvalid (in category 'stat') -----
statIsNowInvalid
"All rios copyied from this one, share a stat instance if it exists.
Invalidating that instance means that this and all such derived rios,
will refresh their stat when needed."
stat ifNotNil: [ stat invalidate ].
!
----- Method: FileKernel>>validateIsDirectory (in category 'validation & errors') -----
validateIsDirectory
self isDirectory ifFalse: [ ^self error: 'not a directory at: ', self value ].
!
----- Method: FileKernel>>validateIsFile (in category 'validation & errors') -----
validateIsFile
self isFile ifFalse: [ ^self error: 'file not readable at: ', self value ].
!
----- Method: FileKernel>>value (in category 'private') -----
value
^ value !
----- Method: FileKernel>>value: (in category 'as yet unclassified') -----
value: aStringable
value := executive importValue: aStringable asString.
!
----- Method: FileKernel>>versions (in category 'versions') -----
versions
| versions |
versions := SortedCollection new.
self splitToBaseVersionAndExt: [ :myB :myV :myE |
self parent entries select: [ :each |
each splitToBaseVersionAndExt: [ :eachB :eachV :eachE |
((eachB = myB) and: [ eachE = myE ]) ifTrue: [ versions add: eachV ] .
false.
]
]
].
^ versions!
----- Method: FileKernel>>writer (in category 'public file') -----
writer
^ self basicWriter!
----- Method: Collection>>ifEmpty: (in category '*file-kernel-override') -----
ifEmpty: aBlock
self isEmpty ifTrue: [ ^ aBlock value ] !
----- Method: PositionableStream>>copyTo: (in category '*file-kernel') -----
copyTo: out
| buffer first |
self atEnd ifTrue: [ ^ self ].
first := self next.
buffer := (first isCharacter
ifTrue: [ String ]
ifFalse: [ out binary. ByteArray ]) new: 50000.
out nextPut: first.
[self atEnd] whileFalse:
[out nextPutAll: (self nextInto: buffer)].
!
----- Method: PositionableStream>>size (in category '*file-kernel') -----
size
^ readLimit!
More information about the Packages
mailing list