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 _______________________________________________ help-smalltalk mailing list [hidden email] http://lists.gnu.org/mailman/listinfo/help-smalltalk |
Free forum by Nabble | Edit this page |