[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Help-smalltalk] [PATCH] convert VFS handlers to be FilePath subclasses
|
From: |
Paolo Bonzini |
|
Subject: |
[Help-smalltalk] [PATCH] convert VFS handlers to be FilePath subclasses |
|
Date: |
Sat, 05 Apr 2008 14:54:18 -0000 |
This converts the VFS handlers to be FilePath subclasses. Besides
removing the Handler suffix and adding some more methods like
#displayOn:, the changes are small. A lot of code goes away
because RealFileHandler and VFSHandler are now elsewhere (in
File and FilePath respectively).
The VFSAddOns package is still present. You can access 'file#utar'
as ('file' asFile archive: 'utar') and likewise for other filesystems.
Instead, the single-command file wrappers (like #ugz) are gone.
It is possible to add them back, but since the only two really
useful ones are #gz and #ugz, I'd prefer very much to implement
them using the ZLib package.
---
kernel/VFS.st | 1179 +++++++--------------------------------------------
kernel/VFSZip.st | 89 ++---
packages/vfs/VFS.st | 131 ++++---
3 files changed, 278 insertions(+), 1121 deletions(-)
diff --git a/kernel/VFS.st b/kernel/VFS.st
index 2497498..342f47e 100644
--- a/kernel/VFS.st
+++ b/kernel/VFS.st
@@ -29,817 +29,70 @@
|
======================================================================"
-
-
Namespace current: VFS [
-Object subclass: VFSHandler [
+FilePath subclass: FileWrapper [
+ | file |
<category: 'Streams-Files'>
- <comment: 'VFSHandler is the abstract class for
-implementations of File and Directory. These classes only
-delegate to the appropriate handler, which is in charge of
-actually accessing or ``molding'''' the filesystem.'>
-
- Registry := nil.
+ <comment: 'FileWrapper gives information for
+virtual files that refer to a real file on disk.'>
- VFSHandler class >> for: fileName [
- "Answer the (real or virtual) file handler for the file named fileName"
-
- <category: 'instance creation'>
- | pos1 fsName pos2 subPath file result |
- file := fileName.
- pos1 := file indexOf: $#.
- pos1 = 0 ifTrue: [^RealFileHandler new name: file].
- result := RealFileHandler new name: (file copyFrom: 1 to: pos1 - 1).
-
- ["Extract the file name and path, and resolve the first virtual
- file path (for example abc#uzip/def in abc#uzip/def#ugz)"
-
- file := file copyReplaceAll: Directory pathSeparatorString with: '/'.
- fsName := file copyFrom: pos1 + 1
- to: (file
- indexOf: $/
- startingAt: pos1
- ifAbsent: [file size + 1]) - 1.
- pos2 := file
- indexOf: $#
- startingAt: pos1 + 1
- ifAbsent: [file size + 1].
- subPath := pos1 + fsName size + 2 >= pos2
- ifTrue: [nil]
- ifFalse: [file copyFrom: pos1 + fsName size + 2 to: pos2 -
1].
- pos2 > file size]
- whileFalse:
- [result := self
- vfsFor: result
- name: fsName
- subPath: (file copyFrom: pos1 + fsName size + 2
to: pos2 - 1).
- file := file copyFrom: pos2.
- pos1 := 1].
-
- "Resolve the last virtual file path"
- ^self
- vfsFor: result
- name: fsName
- subPath: subPath
- ]
-
- VFSHandler class >> initialize [
+ FileWrapper class >> initialize [
"Register the receiver with ObjectMemory"
<category: 'initializing'>
ObjectMemory addDependent: self.
- self update: #returnFromSnapshot
]
- VFSHandler class >> update: aspect [
+ FileWrapper class >> update: aspect [
"Private - Remove the files before quitting, and register the virtual
filesystems specified by the subclasses upon image load."
<category: 'initializing'>
- (aspect == #returnFromSnapshot or: [aspect == #finishedSnapshot])
- ifTrue: [Registry := nil].
- (aspect == #aboutToQuit or: [aspect == #aboutToSnapshot])
- ifTrue: [self allSubclassesDo: [:each | each release]].
- aspect == #aboutToQuit
- ifTrue:
- [self broadcast: #release.
- self release]
- ]
-
- VFSHandler class >> priority [
- "Answer the priority for this class (higher number = higher priority) in
- case multiple classes implement the same file system. The default is
0."
-
- <category: 'initializing'>
- ^0
- ]
-
- VFSHandler class >> fileSystems [
- "Answer the virtual file systems that can be processed by this subclass.
- The default is to answer an empty array, but subclasses can override
- this. If you do so, you should override #vfsFor:name:subPath: as well
- or you risk infinite loops."
-
- <category: 'initializing'>
- ^#()
- ]
-
- VFSHandler class >> register: fileSystem forClass: vfsHandlerClass [
- "Register the given file system to be handled by an instance of
- vfsHandlerClass. This is automatically called if the class overrides
- #fileSystems."
-
- <category: 'initializing'>
- ((Registry includesKey: fileSystem) not
- or: [(Registry at: fileSystem) priority < vfsHandlerClass
priority])
- ifTrue: [Registry at: fileSystem put: vfsHandlerClass]
- ]
-
- VFSHandler class >> register [
- <category: 'private'>
- Registry isNil ifTrue: [VFSHandler registerAll].
- self fileSystems do: [:fs | VFSHandler register: fs forClass: self]
- ]
-
- VFSHandler class >> registerAll [
- "Register all file systems under the VFSHandler hierarchy."
-
- <category: 'private'>
- Registry isNil ifTrue: [Registry := LookupTable new].
- self allSubclassesDo: [:each | each register]
- ]
-
- VFSHandler class >> vfsFor: parent name: fsName subPath: subPath [
- "Create an instance of a subclass of the receiver, implementing the
virtual
- file `subPath' inside the `fileName' archive. fsName is the virtual
- filesystem name and is used to determine the subclass to be
instantiated."
-
- <category: 'private'>
- | handler handlerClass |
- Registry isNil ifTrue: [self registerAll].
- handlerClass := Registry at: fsName.
- handler := handlerClass vfsFor: parent name: fsName.
- ^subPath isNil ifTrue: [handler] ifFalse: [handler at: subPath]
- ]
-
- lstatOn: fileName into: stat [
- <category: 'private-C call-outs'>
- <cCall: 'lstat_obj' returning: #int args: #(#string #smalltalk)>
-
- ]
-
- statOn: fileName into: stat [
- <category: 'private-C call-outs'>
- <cCall: 'stat_obj' returning: #int args: #(#string #smalltalk)>
-
- ]
-
- openDir: dirName [
- <category: 'private-C call-outs'>
- <cCall: 'opendir' returning: #cObject args: #(#string)>
-
- ]
-
- closeDir: dirObject [
- <category: 'private-C call-outs'>
- <cCall: 'closedir' returning: #int args: #(#cObject)>
-
- ]
-
- primChmod: name mode: mode [
- <category: 'private-C call-outs'>
- <cCall: 'chmod' returning: #int args: #(#string #int)>
-
- ]
-
- primIsReadable: name [
- <category: 'private-C call-outs'>
- <cCall: 'fileIsReadable' returning: #boolean args: #(#string)>
-
- ]
-
- primIsWriteable: name [
- <category: 'private-C call-outs'>
- <cCall: 'fileIsWriteable' returning: #boolean args: #(#string)>
-
- ]
-
- primIsExecutable: name [
- <category: 'private-C call-outs'>
- <cCall: 'fileIsExecutable' returning: #boolean args: #(#string)>
-
- ]
-
- primSymlink: srcName as: destName [
- <category: 'private-C call-outs'>
- <cCall: 'symlink' returning: #void args: #(#string #string)>
-
- ]
-
- primUnlink: fileName [
- <category: 'private-C call-outs'>
- <cCall: 'unlink' returning: #void args: #(#string)>
-
- ]
-
- primRename: oldFileName to: newFileName [
- <category: 'private-C call-outs'>
- <cCall: 'rename' returning: #void args: #(#string #string)>
-
- ]
-
- primRemoveDir: fileName [
- <category: 'private-C call-outs'>
- <cCall: 'rmdir' returning: #void args: #(#string)>
-
- ]
-
- primCreateDir: dirName mode: mode [
- <category: 'private-C call-outs'>
- <cCall: 'mkdir' returning: #void args: #(#string #int)>
-
- ]
-
- extractDirentName: dirent [
- <category: 'private-C call-outs'>
- <cCall: 'extractDirentName' returning: #string args: #(#cObject)>
-
- ]
-
- readDir: dirObject [
- <category: 'private-C call-outs'>
- <cCall: 'readdir' returning: #cObject args: #(#cObject)>
-
- ]
-
- rewindDir: dirObject [
- <category: 'private-C call-outs'>
- <cCall: 'rewinddir' returning: #void args: #(#cObject)>
-
- ]
-
- finalize [
- "Upon finalization, we remove the file that was temporarily holding the
file
- contents"
-
- <category: 'releasing'>
- self release
- ]
-
- fullName [
- "Answer the name of the file identified by the receiver as answered by
- File>>#name."
-
- <category: 'accessing'>
- ^self name
- ]
-
- name [
- "Answer the name of the file identified by the receiver"
-
- <category: 'accessing'>
- self subclassResponsibility
- ]
-
- realFileName [
- "Answer the real file name which holds the file contents,
- or nil if it does not apply."
-
- <category: 'accessing'>
- self subclassResponsibility
- ]
-
- size [
- "Answer the size of the file identified by the receiver"
-
- <category: 'accessing'>
- self subclassResponsibility
- ]
-
- lastAccessTime [
- "Answer the last access time of the file identified by the receiver"
-
- <category: 'accessing'>
- self subclassResponsibility
- ]
-
- lastChangeTime [
- "Answer the last change time of the file identified by the receiver
- (the `last change time' has to do with permissions, ownership and the
- like). On some operating systems, this could actually be the
- file creation time."
-
- <category: 'accessing'>
- self subclassResponsibility
- ]
-
- creationTime [
- "Answer the creation time of the file identified by the receiver.
- On some operating systems, this could actually be the last change time
- (the `last change time' has to do with permissions, ownership and the
- like)."
-
- <category: 'accessing'>
- self subclassResponsibility
- ]
-
- lastModifyTime [
- "Answer the last modify time of the file identified by the receiver
- (the `last modify time' has to do with the actual file contents)."
-
- <category: 'accessing'>
- self subclassResponsibility
- ]
-
- refresh [
- "Refresh the statistics for the receiver"
-
- <category: 'accessing'>
-
- ]
-
- exists [
- "Answer whether a file with the name contained in the receiver does
exist."
-
- <category: 'testing'>
- ^true
- ]
-
- isSymbolicLink [
- "Answer whether the file is a symbolic link."
-
- <category: 'testing'>
- ^false
- ]
-
- isDirectory [
- "Answer whether a file with the name contained in the receiver does
exist
- and identifies a directory."
-
- <category: 'testing'>
- ^false
- ]
-
- isReadable [
- "Answer whether a file with the name contained in the receiver does
exist
- and is readable"
-
- <category: 'testing'>
- self subclassResponsibility
- ]
-
- isWriteable [
- "Answer whether a file with the name contained in the receiver does
exist
- and is writeable"
-
- <category: 'testing'>
- self subclassResponsibility
- ]
-
- isExecutable [
- "Answer whether a file with the name contained in the receiver does
exist
- and is executable"
-
- <category: 'testing'>
- self subclassResponsibility
- ]
-
- isAccessible [
- "Answer whether a directory with the name contained in the receiver does
- exist and can be accessed"
-
- <category: 'testing'>
- ^self isExecutable
- ]
-
- lastAccessTime: accessDateTime lastModifyTime: modifyDateTime [
- "Set the receiver's timestamps to be accessDateTime and modifyDateTime.
- If your file system does not support distinct access and modification
- times, you should discard accessDateTime."
-
- <category: 'file operations'>
- self subclassResponsibility
- ]
-
- open: class mode: mode ifFail: aBlock [
- "Open the receiver in the given mode (as answered by FileStream's
- class constant methods)"
-
- <category: 'file operations'>
- self subclassResponsibility
- ]
-
- open: mode ifFail: aBlock [
- "Open the receiver in the given mode (as answered by FileStream's
- class constant methods)"
-
- <category: 'file operations'>
- ^self
- open: FileStream
- mode: mode
- ifFail: aBlock
- ]
-
- openDescriptor: mode ifFail: aBlock [
- "Open the receiver in the given mode (as answered by FileStream's
- class constant methods)"
-
- <category: 'file operations'>
- ^self
- open: FileDescriptor
- mode: mode
- ifFail: aBlock
- ]
-
- remove [
- "Remove the file with the given path name"
-
- <category: 'file operations'>
- self subclassResponsibility
- ]
-
- symlinkFrom: srcName [
- "Create the receiver as a symlink from the relative path srcName"
-
- <category: 'file operations'>
- self subclassResponsibility
- ]
-
- renameTo: newFileName [
- "Rename the file with the given path name oldFileName to newFileName"
-
- <category: 'file operations'>
- self subclassResponsibility
- ]
-
- at: aName [
- "Answer a VFSHandler for a file named `aName' residing in the directory
- represented by the receiver."
-
- <category: 'directory operations'>
- ^VFSHandler for: (Directory append: aName to: self name)
- ]
-
- createDir: dirName [
- "Create a subdirectory of the receiver, naming it dirName."
-
- <category: 'directory operations'>
- self subclassResponsibility
- ]
-
- do: aBlock [
- "Evaluate aBlock once for each file in the directory represented by the
- receiver, passing its name. aBlock should not return."
-
- <category: 'directory operations'>
- self subclassResponsibility
- ]
-]
-
-]
-
-
-
-Namespace current: VFS [
-
-VFSHandler subclass: RealFileHandler [
- | name stat isSymbolicLink |
-
- <category: 'Streams-Files'>
- <comment: 'RealFileHandler is an handler for
-files that are on disk, as well as for virtual files that end
-up being on disk when they are opened for the first time.'>
-
- Epoch := nil.
-
- RealFileHandler class >> setTimeFor: file atime: atimeSeconds mtime:
mtimeSeconds [
- <category: 'private-C call-outs'>
- <cCall: 'utime' returning: #int args: #(#string #long #long)>
-
- ]
-
- RealFileHandler class >> working [
- "Answer the working directory."
- <category: 'C call-outs'>
- <cCall: 'getCurDirName' returning: #stringOut args: #()>
-
- ]
-
- RealFileHandler class >> initialize [
- "Initialize the receiver's class variables"
-
- <category: 'initialization'>
- Epoch := DateTime
- year: 2000
- day: 1
- hour: 0
- minute: 0
- second: 0
- ]
-
- name [
- "Answer the name of the file identified by the receiver"
-
- <category: 'accessing'>
- ^name
+ aspect == #aboutToQuit ifTrue: [self broadcast: #release]
]
- realFileName [
- "Answer the real file name for the file identified by the receiver"
-
- <category: 'accessing'>
- ^name
- ]
-
- name: aName [
- "Private - Initialize the receiver's instance variables"
-
- <category: 'accessing'>
- name := File fullNameFor: aName
- ]
-
- size [
- "Answer the size of the file identified by the receiver"
-
- <category: 'accessing'>
- ^self stat stSize
- ]
-
- mode [
- "Answer the octal permissions for the file."
-
- <category: 'accessing'>
- ^self stat stMode bitAnd: 4095
- ]
-
- mode: mode [
- "Set the octal permissions for the file to be `mode'."
-
- <category: 'accessing'>
- self primChmod: self name mode: (mode bitAnd: 4095).
- File checkError
- ]
-
- isDirectory [
- "Answer whether the file is a directory."
-
- <category: 'accessing'>
- ^(self stat stMode bitAnd: 61440) = 16384
- ]
-
- isSymbolicLink [
- "Answer whether the file is a symbolic link."
-
- <category: 'accessing'>
- isSymbolicLink isNil ifTrue: [self refresh].
- ^isSymbolicLink
- ]
-
- lastAccessTime [
- "Answer the last access time of the file identified by the receiver"
-
- <category: 'accessing'>
- ^self getDateAndTime: self stat stAtime
- ]
-
- lastChangeTime [
- "Answer the last change time of the file identified by the receiver
- (the `last change time' has to do with permissions, ownership and the
- like). On some operating systems, this could actually be the
- file creation time."
-
- <category: 'accessing'>
- ^self getDateAndTime: self stat stCtime
- ]
-
- creationTime [
- "Answer the creation time of the file identified by the receiver.
- On some operating systems, this could actually be the last change time
- (the `last change time' has to do with permissions, ownership and the
- like)."
-
- <category: 'accessing'>
- ^self getDateAndTime: self stat stCtime
- ]
-
- lastModifyTime [
- "Answer the last modify time of the file identified by the receiver
- (the `last modify time' has to do with the actual file contents)."
-
- <category: 'accessing'>
- ^self getDateAndTime: self stat stMtime
- ]
-
- refresh [
- "Refresh the statistics for the receiver"
-
- <category: 'accessing'>
- stat isNil ifTrue: [stat := Kernel.Stat new].
- self lstatOn: self realFileName into: stat.
- File checkError.
- isSymbolicLink := (stat stMode bitAnd: 61440) = 40960. "S_IFLNK"
- isSymbolicLink
- ifTrue:
- [self statOn: self realFileName into: stat.
- File errno]
- ]
-
- exists [
- "Answer whether a file with the name contained in the receiver does
exist."
-
- <category: 'testing'>
- stat isNil ifTrue: [stat := Kernel.Stat new].
- self lstatOn: self realFileName into: stat.
- File errno == 0 ifFalse: [^false].
- isSymbolicLink := (stat stMode bitAnd: 61440) = 40960. "S_IFLNK"
- isSymbolicLink ifTrue: [self statOn: self realFileName into: stat].
- ^true
- ]
-
- isReadable [
- "Answer whether a file with the name contained in the receiver does
exist
- and is readable"
-
- <category: 'testing'>
- ^self primIsReadable: self realFileName
- ]
-
- isWriteable [
- "Answer whether a file with the name contained in the receiver does
exist
- and is writeable"
-
- <category: 'testing'>
- ^self primIsWriteable: self realFileName
- ]
-
- isExecutable [
- "Answer whether a file with the name contained in the receiver does
exist
- and is executable"
-
- <category: 'testing'>
- ^self primIsExecutable: self realFileName
- ]
-
- lastAccessTime: accessDateTime lastModifyTime: modifyDateTime [
- "Set the receiver's timestamps to be accessDateTime and modifyDateTime."
-
- <category: 'file operations'>
- self class
- setTimeFor: self realFileName
- atime: (self secondsFromDateTime: accessDateTime)
- mtime: (self secondsFromDateTime: modifyDateTime).
- File checkError
- ]
-
- open: class mode: mode ifFail: aBlock [
- "Open the receiver in the given mode (as answered by FileStream's
- class constant methods)"
-
- <category: 'file operations'>
- ^class
- fopen: self realFileName
- mode: mode
- ifFail: aBlock
- ]
-
- remove [
- "Remove the file with the given path name"
-
- <category: 'file operations'>
- self isDirectory
- ifTrue: [self primRemoveDir: self realFileName]
- ifFalse: [self primUnlink: self realFileName].
- File checkError
- ]
-
- symlinkFrom: srcName [
- "Create the receiver as a symlink from path destName"
-
- <category: 'file operations'>
- self primSymlink: srcName as: self realFileName.
- File checkError
- ]
-
- renameTo: newFileName [
- "Rename the file with the given path name to newFileName"
-
- <category: 'file operations'>
- self primRename: self realFileName to: newFileName.
- File checkError
- ]
-
- secondsFromDateTime: aDateTime [
- "Private - Convert a time expressed in seconds from 1/1/2000 to
- an array of two Smalltalk Date and Time objects"
-
- <category: 'private'>
- ^aDateTime asSeconds - Epoch asSeconds
- - (aDateTime offset asSeconds - Epoch offset asSeconds)
- ]
-
- getDateAndTime: time [
- "Private - Convert a time expressed in seconds from 1/1/2000 to
- a Smalltalk DateTime object."
-
- <category: 'private'>
- ^Epoch + (Duration seconds: time)
- offset: (Duration seconds: Time timezoneBias)
- ]
-
- stat [
- "Private - Answer the receiver's statistics' C struct"
-
- <category: 'private'>
- stat isNil ifTrue: [self refresh].
- ^stat
- ]
-
- createDir: dirName [
- "Create a subdirectory of the receiver, naming it dirName."
-
- <category: 'directory operations'>
- self primCreateDir: (Directory append: dirName to: self realFileName)
- mode: 511.
- File checkError
- ]
-
- do: aBlock [
- "Evaluate aBlock once for each file in the directory represented by the
- receiver, passing its name. aBlock should not return."
-
- <category: 'directory operations'>
- | dir entry |
- dir := self openDir: self realFileName.
- File checkError.
-
- [entry := self readDir: dir.
- File checkError.
- entry notNil]
- whileTrue: [aBlock value: (self extractDirentName: entry)].
- self closeDir: dir
- ]
-]
-
-]
-
-
-
-Namespace current: VFS [
-
-VFSHandler subclass: FileHandlerWrapper [
- | parent fsName |
-
- <category: 'Streams-Files'>
- <comment: 'DecodedFileHandler handles
-virtual filesystems that take a file that is on-disk, run a
-command on it, and then read from the result.'>
-
- FileHandlerWrapper class [
- | activePaths |
-
- ]
-
- FileHandlerWrapper class >> vfsFor: parent name: fsName [
+ FileWrapper class >> on: file [
"Create an instance of this class representing the contents of the given
file, under the virtual filesystem fsName."
<category: 'instance creation'>
- ^self activePaths at: fsName -> parent name
- ifAbsentPut: [self new parent: parent fsName: fsName]
+ ^self new file: file
]
- FileHandlerWrapper class >> activePaths [
- "Answer a dictionary that stores the currently opened archive file
- members, to avoid extracting members multiple times. Might be
- worthwhile to push it to the superclass."
-
- <category: 'private'>
- activePaths isNil ifTrue: [activePaths := WeakValueLookupTable new].
- ^activePaths
+ asString [
+ "Answer the container file containing me."
+ <category: 'accessing'>
+ ^self file asString
]
- FileHandlerWrapper class >> release [
- <category: 'private'>
- activePaths := nil.
- super release
- ]
+ isAbsolute [
+ "Answer whether the receiver identifies an absolute path."
- fsName [
- <category: 'private'>
- ^fsName
+ ^self file isAbsolute
]
- name [
- "Answer the VFS name for my file."
- <category: 'accessing'>
- ^self parent name , '#' , self fsName
- ]
-
- parent [
- <category: 'accessing'>
- ^parent
- ]
+ full [
+ "Answer the size of the file identified by the receiver"
- realFileName [
- "Answer the container file containing me."
- <category: 'accessing'>
- ^self parent realFileName
+ <category: 'delegation'>
+ self isAbsolute ifTrue: [ ^self ].
+ ^self class on: self file full
]
size [
"Answer the size of the file identified by the receiver"
<category: 'delegation'>
- ^self parent size
+ ^self file size
]
lastAccessTime [
"Answer the last access time of the file identified by the receiver"
<category: 'delegation'>
- ^self parent lastAccessTime
+ ^self file lastAccessTime
]
lastChangeTime [
@@ -849,7 +102,7 @@ command on it, and then read from the result.'>
file creation time."
<category: 'delegation'>
- ^self parent lastChangeTime
+ ^self file lastChangeTime
]
creationTime [
@@ -859,7 +112,7 @@ command on it, and then read from the result.'>
like)."
<category: 'delegation'>
- ^self parent creationTime
+ ^self file creationTime
]
lastModifyTime [
@@ -867,7 +120,7 @@ command on it, and then read from the result.'>
(the `last modify time' has to do with the actual file contents)."
<category: 'delegation'>
- ^self parent lastModifyTime
+ ^self file lastModifyTime
]
isReadable [
@@ -875,7 +128,7 @@ command on it, and then read from the result.'>
and is readable"
<category: 'delegation'>
- ^self parent isReadable
+ ^self file isReadable
]
isWriteable [
@@ -883,7 +136,7 @@ command on it, and then read from the result.'>
and is writeable"
<category: 'delegation'>
- ^self parent isWritable
+ ^self file isWritable
]
isExecutable [
@@ -891,7 +144,7 @@ command on it, and then read from the result.'>
and is executable"
<category: 'delegation'>
- ^self parent isExecutable
+ ^self file isExecutable
]
open: class mode: mode ifFail: aBlock [
@@ -899,7 +152,7 @@ command on it, and then read from the result.'>
class constant methods)"
<category: 'delegation'>
- ^self parent
+ ^self file
open: class
mode: mode
ifFail: aBlock
@@ -909,172 +162,44 @@ command on it, and then read from the result.'>
"Remove the file with the given path name"
<category: 'delegation'>
- self parent remove
+ self file remove
]
- parent: containerFileHandler fsName: aString [
+ file [
<category: 'private'>
- parent := containerFileHandler.
- fsName := aString
- ]
-]
-
-]
-
-
-
-Namespace current: VFS [
-
-FileHandlerWrapper subclass: DecodedFileHandler [
- | realFileName |
-
- <category: 'Streams-Files'>
- <comment: nil>
-
- DecodedFileHandler class [
- | fileTypes |
-
- ]
-
- DecodedFileHandler class >> priority [
- "Answer the priority for this class (higher number = higher priority) in
- case multiple classes implement the same file system."
-
- <category: 'registering'>
- ^-10
+ ^file
]
- DecodedFileHandler class >> fileTypes [
- "Return the valid virtual filesystems and the associated
- filter commands."
-
- <category: 'registering'>
- fileTypes isNil ifTrue: [fileTypes := self defaultFileTypes].
- ^fileTypes
- ]
-
- DecodedFileHandler class >> defaultFileTypes [
- "Return the default virtual filesystems and the associated
- filter commands."
-
- <category: 'registering'>
- ^(LookupTable new)
- at: 'Z' put: 'compress -cf %1 > %2';
- at: 'uZ' put: 'zcat -f %1 > %2';
- at: 'gz' put: 'gzip -cf %1 > %2';
- at: 'ugz' put: 'gzip -cdf %1 > %2';
- at: 'bz2' put: 'bzip2 -c %1 > %2';
- at: 'ubz2' put: 'bzip2 -cd %1 > %2';
- at: 'tar' put: 'tar chof %2 %1';
- at: 'tgz' put: 'tar chof - %1 | gzip -cf > %2';
- at: 'nop' put: 'cat %1 > %2';
- at: 'strings' put: 'strings %1 > %2';
- yourself
- ]
-
- DecodedFileHandler class >> fileSystems [
- "Answer the virtual file systems that can be processed by this subclass.
- These are #gz (gzip a file), #ugz (uncompress a gzipped file),
- #Z (compress a file via Unix compress), #uZ (uncompress a compressed
- file), #bz2 (compress a file via bzip2), #ubz2 (uncompress a file via
- bzip2), #tar (make a tar archive out of a directory), #tgz (make a
- gzipped tar archive out of a directory), #nop (do nothing, used for
- testing) and #strings (use the `strings' utility to extract printable
- strings from a file)."
-
- <category: 'registering'>
- ^self fileTypes keys
- ]
-
- at: aName [
- "Signal an error, as this can't represent a file container."
- <category: 'files'>
- SystemExceptions.FileError signal: 'not a tree-shaped filesystem'
- ]
-
- parent: containerFileHandler fsName: aString [
- "Private - Initialize a new object storing the contents of the
- virtualFileName file into temporaryFileName."
-
- <category: 'files'>
- | temp command pipe file |
- super parent: containerFileHandler fsName: aString.
- command := self class fileTypes at: fsName.
- temp := FileStream openTemporaryFile: Directory temporary , '/vfs'.
-
- "Go through a pipe if the file is completely virtual."
- self parent realFileName isNil
- ifTrue:
- [pipe := FileStream popen: command %
- {'-'.
- temp name}
- dir: FileStream write.
- file := parent open: FileStream read
- ifFail: [self error: 'cannot open input file'].
- pipe nextPutAll: file.
- file close.
- pipe close]
- ifFalse:
- [Smalltalk system: command %
- {parent realFileName.
- temp name}].
- realFileName := temp name.
- temp close.
- VFSHandler addDependent: self.
- self addToBeFinalized
- ]
-
- open: class mode: mode ifFail: aBlock [
- "Open the receiver in the given mode (as answered by FileStream's
- class constant methods)"
-
- <category: 'files'>
- ^class
- fopen: self realFileName
- mode: mode
- ifFail: aBlock
- ]
-
- realFileName [
- "Answer the real file name which holds the file contents,
- or nil if it does not apply."
-
- <category: 'files'>
- ^realFileName
- ]
-
- release [
- "Release the resources used by the receiver that don't survive when
- reloading a snapshot."
-
- "Remove the file that was temporarily holding the file contents"
-
- <category: 'files'>
- realFileName isNil ifTrue: [^self].
- self primUnlink: realFileName.
- realFileName := nil.
- super release
+ file: aFilePath [
+ <category: 'private'>
+ file := aFilePath.
]
]
]
-
Namespace current: VFS [
-FileHandlerWrapper subclass: ArchiveFileHandler [
- | tmpFileHandlers topLevelFiles allFiles extractedFiles |
+FileWrapper subclass: ArchiveFile [
+ | tmpFiles topLevelFiles allFiles extractedFiles |
<category: 'Streams-Files'>
- <comment: 'ArchiveFileHandler handles
+ <comment: 'ArchiveFile handles
virtual filesystems that have a directory structure of
their own. The directories and files in the archive are
-instances of ArchiveMemberHandler, but the functionality
-resides entirely in ArchiveFileHandler because the members
+instances of ArchiveMember, but the functionality
+resides entirely in ArchiveFile because the members
will still ask the archive to get directory information
on them, to extract them to a real file, and so on.'>
+ displayOn: aStream [
+ "Print a representation of the file identified by the receiver."
+ super displayOn: aStream.
+ aStream nextPut: $#.
+ self class printOn: aStream
+ ]
+
isDirectory [
"Answer true. The archive can always be considered as a directory."
@@ -1087,11 +212,11 @@ on them, to extract them to a real file, and so on.'>
exist and can be accessed"
<category: 'querying'>
- ^true
+ ^self isReadable
]
at: aName [
- "Answer a VFSHandler for a file named `aName' residing in the directory
+ "Answer a FilePath for a file named `aName' residing in the directory
represented by the receiver."
<category: 'directory operations'>
@@ -1100,23 +225,32 @@ on them, to extract them to a real file, and so on.'>
data := allFiles at: aName ifAbsent: [nil].
handler := data at: 5 ifAbsent: [nil].
handler isNil ifFalse: [^handler].
- tmpFileHandlers isNil
+ tmpFiles isNil
ifTrue:
- [tmpFileHandlers := LookupTable new.
- VFSHandler addDependent: self.
+ [tmpFiles := LookupTable new.
+ FileWrapper addDependent: self.
self addToBeFinalized].
- ^tmpFileHandlers at: aName
+ ^tmpFiles at: aName
ifAbsentPut:
- [(TmpFileArchiveMemberHandler new)
+ [(TmpFileArchiveMember new)
name: aName;
- parent: self]
+ archive: self]
]
- do: aBlock [
+ nameAt: aString [
+ "Answer a FilePath for a file named `aName' residing in the directory
+ represented by the receiver."
+
+ <category: 'directory operations'>
+ ^aString
+ ]
+
+ namesDo: aBlock [
"Evaluate aBlock once for each file in the directory represented by the
receiver, passing its name."
<category: 'directory operations'>
+ topLevelFiles isNil ifTrue: [self refresh].
topLevelFiles do: aBlock
]
@@ -1125,10 +259,10 @@ on them, to extract them to a real file, and so on.'>
reloading a snapshot."
<category: 'directory operations'>
- tmpFileHandlers isNil
+ tmpFiles isNil
ifFalse:
- [tmpFileHandlers do: [:each | each release].
- tmpFileHandlers := nil].
+ [tmpFiles do: [:each | each release].
+ tmpFiles := nil].
extractedFiles isNil
ifFalse:
[extractedFiles do: [:each | self primUnlink: each].
@@ -1136,29 +270,29 @@ on them, to extract them to a real file, and so on.'>
super release
]
- fillMember: anArchiveMemberHandler [
- "Extract the information on anArchiveMemberHandler. Answer
+ fillMember: anArchiveMember [
+ "Extract the information on anArchiveMember. Answer
false if it actually does not exist in the archive; otherwise,
- answer true after having told anArchiveMemberHandler about them
+ answer true after having told anArchiveMember about them
by sending #size:stCtime:stMtime:stAtime:isDirectory: to it."
- <category: 'ArchiveMemberHandler protocol'>
+ <category: 'ArchiveMember protocol'>
| data |
allFiles isNil ifTrue: [self refresh].
- data := allFiles at: anArchiveMemberHandler name ifAbsent: [nil].
+ data := allFiles at: anArchiveMember name ifAbsent: [nil].
data isNil ifTrue: [^false].
- anArchiveMemberHandler fillFrom: data.
+ anArchiveMember fillFrom: data.
^true
]
- member: anArchiveMemberHandler do: aBlock [
+ member: anArchiveMember do: aBlock [
"Evaluate aBlock once for each file in the directory represented by
- anArchiveMemberHandler, passing its name."
+ anArchiveMember, passing its name."
- <category: 'ArchiveMemberHandler protocol'>
+ <category: 'ArchiveMember protocol'>
| data |
allFiles isNil ifTrue: [self refresh].
- data := allFiles at: anArchiveMemberHandler name ifAbsent: [nil].
+ data := allFiles at: anArchiveMember name ifAbsent: [nil].
data isNil ifTrue: [^SystemExceptions.FileError signal: 'File not
found'].
(data at: 1) isNil
ifTrue: [^SystemExceptions.FileError signal: 'Not a directory'].
@@ -1168,7 +302,7 @@ on them, to extract them to a real file, and so on.'>
refresh [
"Extract the directory listing from the archive"
- <category: 'ArchiveMemberHandler protocol'>
+ <category: 'ArchiveMember protocol'>
| pipe line parentPath name current currentPath directoryTree directory
|
super refresh.
current := currentPath := nil.
@@ -1208,48 +342,48 @@ on them, to extract them to a real file, and so on.'>
do: [:data | (data at: 1) isNil ifFalse: [data at: 1 put: (data at:
1) keys asArray]]
]
- member: anArchiveMemberHandler mode: bits [
- "Set the permission bits for the file in anArchiveMemberHandler."
+ member: anArchiveMember mode: bits [
+ "Set the permission bits for the file in anArchiveMember."
- <category: 'ArchiveMemberHandler protocol'>
+ <category: 'ArchiveMember protocol'>
self subclassResponsibility
]
- removeMember: anArchiveMemberHandler [
- "Remove the member represented by anArchiveMemberHandler."
+ removeMember: anArchiveMember [
+ "Remove the member represented by anArchiveMember."
- <category: 'ArchiveMemberHandler protocol'>
+ <category: 'ArchiveMember protocol'>
self subclassResponsibility
]
- updateMember: anArchiveMemberHandler [
- "Update the member represented by anArchiveMemberHandler by
+ updateMember: anArchiveMember [
+ "Update the member represented by anArchiveMember by
copying the file into which it was extracted back to the
archive."
- <category: 'ArchiveMemberHandler protocol'>
+ <category: 'ArchiveMember protocol'>
self subclassResponsibility
]
- extractMember: anArchiveMemberHandler [
- "Extract the contents of anArchiveMemberHandler into a file
+ extractMember: anArchiveMember [
+ "Extract the contents of anArchiveMember into a file
that resides on disk, and answer the name of the file."
- <category: 'TmpFileArchiveMemberHandler protocol'>
+ <category: 'TmpFileArchiveMember protocol'>
extractedFiles isNil ifTrue: [extractedFiles := IdentityDictionary new].
- ^extractedFiles at: anArchiveMemberHandler
+ ^extractedFiles at: anArchiveMember
ifAbsentPut:
[| temp |
temp := FileStream openTemporaryFile: Directory temporary ,
'/vfs'.
- self extractMember: anArchiveMemberHandler into: temp.
- File fullNameFor: temp name]
+ self extractMember: anArchiveMember into: temp.
+ File name: temp name]
]
- extractMember: anArchiveMemberHandler into: file [
- "Extract the contents of anArchiveMemberHandler into a file
+ extractMember: anArchiveMember into: file [
+ "Extract the contents of anArchiveMember into a file
that resides on disk, and answer the name of the file."
- <category: 'TmpFileArchiveMemberHandler protocol'>
+ <category: 'TmpFileArchiveMember protocol'>
self subclassResponsibility
]
@@ -1322,23 +456,30 @@ on them, to extract them to a real file, and so on.'>
Namespace current: VFS [
-VFSHandler subclass: ArchiveMemberHandler [
- | parent name mode size stCtime stMtime stAtime |
+FilePath subclass: ArchiveMember [
+ | archive name mode size stCtime stMtime stAtime |
<category: 'Streams-Files'>
- <comment: 'TmpFileArchiveMemberHandler is a handler
+ <comment: 'TmpFileArchiveMember is a handler
class for members of archive files that creates temporary files when
extracting files from an archive.'>
- parent: anArchiveFileHandler [
+ archive: anArchiveFile [
"Set the archive of which the receiver is a member."
<category: 'initializing'>
- parent := anArchiveFileHandler
+ archive := anArchiveFile
+ ]
+
+ full [
+ "Answer the size of the file identified by the receiver"
+
+ <category: 'delegation'>
+ ^self archive full at: self name
]
fillFrom: data [
- "Called back by the receiver's parent when the ArchiveMemberHandler
+ "Called back by the receiver's archive when the ArchiveMember
asks for file information."
<category: 'initializing'>
@@ -1353,9 +494,9 @@ extracting files from an archive.'>
<category: 'initializing'>
size := bytes.
- stCtime := self parent lastModifyTime.
+ stCtime := self archive lastModifyTime.
stMtime := mtime.
- stAtime := self parent lastAccessTime.
+ stAtime := self archive lastAccessTime.
mode := modeBits
]
@@ -1370,17 +511,25 @@ extracting files from an archive.'>
mode := modeBits
]
- realFileName [
- <category: 'accessing'>
- ^nil
- ]
-
- fullName [
+ asString [
"Answer the name of the file identified by the receiver as answered by
File>>#name."
<category: 'accessing'>
- ^Directory append: self name to: self parent name
+ ^self name
+ ]
+
+ displayOn: aStream [
+ "Print a representation of the file identified by the receiver."
+ self archive displayOn: aStream.
+ aStream nextPut: $/.
+ super displayOn: aStream
+ ]
+
+ isAbsolute [
+ "Answer whether the receiver identifies an absolute path."
+
+ ^self archive isAbsolute
]
name [
@@ -1397,11 +546,11 @@ extracting files from an archive.'>
name := aName
]
- parent [
+ archive [
"Answer the archive of which the receiver is a member."
<category: 'accessing'>
- ^parent
+ ^archive
]
size [
@@ -1455,14 +604,14 @@ extracting files from an archive.'>
"Refresh the statistics for the receiver"
<category: 'accessing'>
- self parent fillMember: self
+ self archive fillMember: self
]
exists [
"Answer whether a file with the name contained in the receiver does
exist."
<category: 'testing'>
- ^self parent fillMember: self
+ ^self archive fillMember: self
]
mode [
@@ -1477,7 +626,7 @@ extracting files from an archive.'>
"Set the octal permissions for the file to be `mode'."
<category: 'testing'>
- self parent member: self mode: (mode bitAnd: 4095)
+ self archive member: self mode: (mode bitAnd: 4095)
]
isDirectory [
@@ -1534,9 +683,9 @@ extracting files from an archive.'>
<category: 'file operations'>
aspect == #beforeClosing
- ifTrue: [self parent updateMember: self] aspect == #afterClosing
+ ifTrue: [self archive updateMember: self] aspect == #afterClosing
ifTrue:
- [self parent refresh.
+ [self archive refresh.
self refresh]
]
@@ -1544,7 +693,7 @@ extracting files from an archive.'>
"Remove the file with the given path name"
<category: 'file operations'>
- self parent removeMember: self.
+ self archive removeMember: self.
File checkError
]
@@ -1556,26 +705,33 @@ extracting files from an archive.'>
]
at: aName [
- "Answer a VFSHandler for a file named `aName' residing in the directory
+ "Answer a FilePath for a file named `aName' residing in the directory
represented by the receiver."
<category: 'directory operations'>
- ^self parent at: (Directory append: aName to: self name)
+ ^self archive at: (File append: aName to: self name)
]
- createDir: dirName [
+ , aName [
+ "Answer an object of the same kind as the receiver, whose name
+ is suffixed with aName."
+
+ ^self archive at: (self name, aName)
+ ]
+
+ createDirectory: dirName [
"Create a subdirectory of the receiver, naming it dirName."
<category: 'directory operations'>
- self parent createDir: (Directory append: dirName to: self name)
+ self archive createDirectory: (File append: dirName to: self name)
]
- do: aBlock [
+ namesDo: aBlock [
"Evaluate aBlock once for each file in the directory represented by the
receiver, passing its name."
<category: 'directory operations'>
- self parent member: self do: aBlock
+ self archive member: self do: aBlock
]
]
@@ -1585,8 +741,8 @@ extracting files from an archive.'>
Namespace current: VFS [
-ArchiveMemberHandler subclass: TmpFileArchiveMemberHandler [
- | realFileName |
+ArchiveMember subclass: TmpFileArchiveMember [
+ | file |
<category: 'Streams-Files'>
<comment: nil>
@@ -1598,9 +754,7 @@ ArchiveMemberHandler subclass: TmpFileArchiveMemberHandler
[
"Remove the file that was temporarily holding the file contents"
<category: 'finalization'>
- realFileName isNil ifTrue: [^self].
- self primUnlink: realFileName.
- realFileName := nil.
+ self extracted ifTrue: [ file remove. file := nil ].
super release
]
@@ -1610,35 +764,30 @@ ArchiveMemberHandler subclass:
TmpFileArchiveMemberHandler [
<category: 'directory operations'>
| fileStream |
- self realFileName isNil ifTrue: [^aBlock value].
- fileStream := class
- fopen: self realFileName
- mode: mode
- ifFail: [^aBlock value].
+ self file isNil ifTrue: [^aBlock value].
+ fileStream := file open: class mode: mode ifFail: [^aBlock value].
mode == FileStream read ifFalse: [fileStream addDependent: self].
- fileStream setFile: (File on: self).
+ fileStream setFile: self.
^fileStream
]
- realFileName [
+ extracted [
+ "Answer whether the file has already been extracted to disk."
+ ^file notNil
+ ]
+
+ file [
"Answer the real file name which holds the file contents,
or nil if it does not apply."
<category: 'directory operations'>
- realFileName isNil ifFalse: [^realFileName].
+ file isNil ifFalse: [^file].
self exists ifFalse: [^nil].
- realFileName := self parent extractMember: self.
- ^realFileName
+ file := self archive extractMember: self.
+ ^file
]
]
]
-
-Eval [
- VFS.RealFileHandler initialize.
- VFS.DecodedFileHandler initialize.
- VFS.VFSHandler initialize
-]
-
diff --git a/kernel/VFSZip.st b/kernel/VFSZip.st
index 94a980a..96bdfcb 100644
--- a/kernel/VFSZip.st
+++ b/kernel/VFSZip.st
@@ -1,6 +1,6 @@
"======================================================================
|
-| Virtual File System for ZIP files
+| Virtual File System (new classes)
|
|
======================================================================"
@@ -29,69 +29,52 @@
|
======================================================================"
+Namespace current: VFS [
-
-Namespace current: Kernel [
-
-VFS.VFS.ArchiveFileHandler subclass: ZipFileHandler [
+ArchiveFile subclass: ZipFile [
<category: 'Streams-Files'>
- <comment: 'ZipFileHandler transparently extracts
+ <comment: 'ZipFile transparently extracts
files from a ZIP archive.'>
- ZipFileHandler class >> priority [
- "Answer the priority for this class (higher number = higher priority) in
- case multiple classes implement the same file system."
-
- <category: 'registering'>
- ^-10
- ]
-
- ZipFileHandler class >> fileSystems [
- "Answer the virtual file systems that can be processed by this
subclass."
-
- <category: 'registering'>
- ^#('uzip')
- ]
-
- createDir: dirName [
+ createDirectory: dirName [
"Create a subdirectory of the receiver, naming it dirName."
<category: 'members'>
self notYetImplemented
]
- member: anArchiveMemberHandler mode: bits [
- "Set the permission bits for the file in anArchiveMemberHandler."
+ member: anArchiveMember mode: bits [
+ "Set the permission bits for the file in anArchiveMember."
<category: 'members'>
self notYetImplemented
]
- extractMember: anArchiveMemberHandler into: temp [
- "Extract the contents of anArchiveMemberHandler into a file
+ extractMember: anArchiveMember into: temp [
+ "Extract the contents of anArchiveMember into a file
that resides on disk, and answer the name of the file."
<category: 'members'>
Smalltalk
system: 'unzip -p %1 %2 > %3' %
- {self realFileName.
- anArchiveMemberHandler name.
+ {self file name.
+ anArchiveMember name.
temp name}
]
- removeMember: anArchiveMemberHandler [
- "Remove the member represented by anArchiveMemberHandler."
+ removeMember: anArchiveMember [
+ "Remove the member represented by anArchiveMember."
<category: 'members'>
Smalltalk
system: 'zip -d %1 %2' %
- {self realFileName.
- anArchiveMemberHandler name}
+ {self file name.
+ anArchiveMember name}
]
- updateMember: anArchiveMemberHandler [
- "Update the member represented by anArchiveMemberHandler by
+ updateMember: anArchiveMember [
+ "Update the member represented by anArchiveMember by
copying the file into which it was extracted back to the
archive."
@@ -160,7 +143,7 @@ files from a ZIP archive.'>
[data at: 5
put: ((StoredZipMember new)
name: (data at: 1);
- parent: self;
+ archive: self;
offset: ofs;
yourself)].
gen yield: data]]
@@ -171,13 +154,13 @@ files from a ZIP archive.'>
-Namespace current: Kernel [
+Namespace current: VFS [
-VFS.VFS.ArchiveMemberHandler subclass: StoredZipMember [
+TmpFileArchiveMember subclass: StoredZipMember [
| offset |
<category: 'Streams-Files'>
- <comment: 'ArchiveMemberHandler is the handler
+ <comment: 'ArchiveMember is the handler
class for stored ZIP archive members, which are optimized.'>
offset [
@@ -192,25 +175,26 @@ class for stored ZIP archive members, which are
optimized.'>
open: class mode: mode ifFail: aBlock [
<category: 'opening'>
- | file |
- mode = FileStream read ifFalse: [^self notYetImplemented].
- file := self parent
+ | fileStream |
+ (mode = FileStream read or: [ self extracted ])
+ ifFalse: [^super open: class mode: mode ifFail: aBlock].
+
+ fileStream := self archive
open: class
mode: mode
ifFail: [^aBlock value].
- file skip: self offset + 26.
- file skip: file nextUshort + file nextUshort.
- file setFile: (File on: self).
+ fileStream skip: self offset + 26.
+ fileStream skip: fileStream nextUshort + fileStream nextUshort.
+ fileStream setFile: self.
^LimitedStream
- on: file
- from: file position
- to: file position + self size - 1
+ on: fileStream
+ from: fileStream position
+ to: fileStream position + self size - 1
]
]
]
-
Namespace current: Kernel [
@@ -361,8 +345,9 @@ Stream subclass: LimitedStream [
]
-
-Eval [
- Kernel.ZipFileHandler register
+FilePath extend [
+ zip [
+ <category: 'virtual filesystems'>
+ ^VFS.ZipFile on: self
+ ]
]
-
diff --git a/packages/vfs/VFS.st b/packages/vfs/VFS.st
index ac2600c..efd520e 100644
--- a/packages/vfs/VFS.st
+++ b/packages/vfs/VFS.st
@@ -31,26 +31,30 @@
-ArchiveFileHandler subclass: ExternalArchiveFileHandler [
+ArchiveFile subclass: ExternalArchiveFile [
+ | command |
- <comment: 'ExternalArchiveFileHandler
+ <comment: 'ExternalArchiveFile
allows for easy implementation of archive files (for example,
transparent unzipping and untarring) with a single shell script.
It implements a protocol that that is compatible with the Midnight
Commander and with GNOME VFS.'>
<category: 'Streams-Files'>
- ExternalArchiveFileHandler class [
+ ExternalArchiveFile class [
| fileTypes |
]
- ExternalArchiveFileHandler class >> priority [
- <category: 'registering'>
- ^-5
+ ExternalArchiveFile class >> update: aSymbol [
+ aSymbol == #returnedFromSnapshot ifTrue: [ self release ].
+ ]
+
+ ExternalArchiveFile class >> release [
+ fileTypes := nil
]
- ExternalArchiveFileHandler class >> fileSystems [
+ ExternalArchiveFile class >> refreshFileSystemList [
"Answer the virtual file systems that can be processed by this
subclass. These are given by the names of the executable
files in the `vfs' subdirectory of the image directory (if
@@ -61,7 +65,7 @@ Commander and with GNOME VFS.'>
<category: 'registering'>
fileTypes := LookupTable new.
[self fileSystemsIn: Directory libexec / 'vfs'] on: Error
- do: [:ex | ex return].
+ do: [:ex | ex pass].
[self fileSystemsIn: Directory userBase / 'vfs'] on: Error
do: [:ex | ex return].
Smalltalk imageLocal
@@ -71,109 +75,116 @@ Commander and with GNOME VFS.'>
^fileTypes keys asSet
]
- ExternalArchiveFileHandler class >> fileSystemsIn: path [
+ ExternalArchiveFile class >> fileSystemsIn: dir [
"Registers the executable files in the given directory to be used
to resolve a virtual file system."
<category: 'registering'>
- | dir |
- dir := RealFileHandler for: path.
- dir exists ifFalse: [^self].
+ dir isDirectory ifFalse: [^self].
dir do:
[:each |
- (File isExecutable: path , '/' , each)
- ifTrue: [fileTypes at: each put: path , '/' , each]]
+ each isExecutable
+ ifTrue: [fileTypes at: each stripPath put: each asString]]
]
- ExternalArchiveFileHandler class >> fileTypes [
+ ExternalArchiveFile class >> commandFor: fileSystem [
<category: 'registering'>
- ^fileTypes
+ fileTypes isNil ifTrue: [ self refreshFileSystemList ].
+ ^fileTypes at: fileSystem asString
]
- ExternalArchiveFileHandler class >> release [
- "Avoid that paths stay in the image file"
+ command: aString [
+ <category: 'string'>
- <category: 'registering'>
- fileTypes := nil.
- super release
+ command := aString
]
- createDir: dirName [
+ createDirectory: dirName [
"Create a subdirectory of the receiver, naming it dirName."
<category: 'members'>
Smalltalk
system: '%1 mkdir %2 %3' %
- {self command.
- self realFileName.
+ {command.
+ self file name.
dirName}
]
- member: anArchiveMemberHandler mode: bits [
- "Set the permission bits for the file in anArchiveMemberHandler."
+ full [
+ "Answer the size of the file identified by the receiver"
+
+ <category: 'delegation'>
+ self isAbsolute ifTrue: [ ^self ].
+ ^super full
+ command: command;
+ yourself
+ ]
- <category: 'ArchiveMemberHandler protocol'>
+ member: anArchiveMember mode: bits [
+ "Set the permission bits for the file in anArchiveMember."
+
+ <category: 'ArchiveMember protocol'>
self notYetImplemented
]
- extractMember: anArchiveMemberHandler into: file [
- "Extract the contents of anArchiveMemberHandler into a file
+ extractMember: anArchiveMember into: file [
+ "Extract the contents of anArchiveMember into a file
that resides on disk, and answer the name of the file."
- <category: 'ArchiveMemberHandler protocol'>
+ <category: 'ArchiveMember protocol'>
Smalltalk
system: '%1 copyout %2 %3 %4' %
- {self command.
- self realFileName.
- anArchiveMemberHandler name.
+ {command.
+ self file name.
+ anArchiveMember name.
file name}
]
- removeMember: anArchiveMemberHandler [
- "Remove the member represented by anArchiveMemberHandler."
+ removeMember: anArchiveMember [
+ "Remove the member represented by anArchiveMember."
- <category: 'ArchiveMemberHandler protocol'>
+ <category: 'ArchiveMember protocol'>
| subcmd |
- subcmd := anArchiveMemberHandler isDirectory
+ subcmd := anArchiveMember isDirectory
ifTrue: ['rmdir']
ifFalse: ['rm'].
Smalltalk
system: '%1 %2 %3 %4' %
- {self command.
+ {command.
subcmd.
- self realFileName.
- anArchiveMemberHandler name}
+ self file name.
+ anArchiveMember name}
]
- updateMember: anArchiveMemberHandler [
- "Update the member represented by anArchiveMemberHandler by
+ updateMember: anArchiveMember [
+ "Update the member represented by anArchiveMember by
copying the file into which it was extracted back to the
archive."
- <category: 'ArchiveMemberHandler protocol'>
+ <category: 'ArchiveMember protocol'>
Smalltalk
system: '%1 copyin %2 %3 %4' %
- {self command.
- self realFileName.
- anArchiveMemberHandler name.
- anArchiveMemberHandler realFileName}
+ {command.
+ self file name.
+ anArchiveMember name.
+ anArchiveMember file name}
]
command [
"Return the script that is invoked by the receiver."
- <category: 'ArchiveMemberHandler protocol'>
+ <category: 'ArchiveMember protocol'>
^self class fileTypes at: self fsName
]
files [
"Extract the directory listing from the archive"
- <category: 'ArchiveMemberHandler protocol'>
+ <category: 'ArchiveMember protocol'>
^Generator on:
[:gen |
| pipe |
- pipe := FileStream popen: self command , ' list ' , self
realFileName
+ pipe := FileStream popen: command , ' list ' , self file name
dir: FileStream read.
pipe linesDo:
[:l |
@@ -201,9 +212,21 @@ Commander and with GNOME VFS.'>
]
]
-
-Eval [
- ExternalArchiveFileHandler register
-]
+FilePath extend [
+ archive: kind [
+ "Return a FilePath for the receiver, interpreted as an archive file
+ of the given kind."
+ <category: 'factory'>
+ ^(VFS.ExternalArchiveFile on: self)
+ command: (VFS.ExternalArchiveFile commandFor: kind);
+ yourself
+ ]
+ zip [
+ "Return a FilePath for the receiver, interpreted as an archive file
+ of the given kind."
+ <category: 'factory'>
+ ^self archive: 'uzip'
+ ]
+]
--
1.5.3.4.910.gc5122-dirty
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Help-smalltalk] [PATCH] convert VFS handlers to be FilePath subclasses,
Paolo Bonzini <=