[Help-smalltalk] [PATCH] RecursiveFileWrapper

[Paolo Bonzini]

This decorator is on the list of things missing in gst that are in the 
Squeak Rio package.  Easy. :-)

Paolo

2008-04-08  Paolo Bonzini  <address@hidden>

        * kernel/FilePath.st: Add more abstract methods.  Implement
        #lastAccessTime: and #lastModifyTime:.  Add #all.  Do not
        create full paths in #namesMatching:do: for similarity with
        #namesDo:.
        * kernel/VFS.st: Add more delegation methods.  Implement
        RecursiveFileWrapper.
 
diff --git a/kernel/FilePath.st b/kernel/FilePath.st
index 7599b4a..ffe297a 100644
--- a/kernel/FilePath.st
+++ b/kernel/FilePath.st
@@ -298,7 +298,7 @@ size and timestamps.'>
         to be aDateTime."
 
        <category: 'accessing'>
-       self subclassResponsibility
+       self lastAccessTime: aDateTime lastModifyTime: self lastModifyTime
     ]
 
     lastAccessTime: accessDateTime lastModifyTime: modifyDateTime [
@@ -341,7 +341,7 @@ size and timestamps.'>
         receiver, to be aDateTime."
 
        <category: 'accessing'>
-       self subclassResponsibility
+       self lastAccessTime: self lastAccessTime lastModifyTime: aDateTime
     ]
 
     lastModifyTime [
@@ -367,7 +367,15 @@ size and timestamps.'>
 
     isSymbolicLink [
        "Answer whether a file with the name contained in the receiver does 
exist
-        and does not identify a directory."
+        and identifies a symbolic link."
+
+       <category: 'testing'>
+       self subclassResponsibility
+    ]
+
+    isDirectory [
+       "Answer whether a file with the name contained in the receiver does 
exist
+        and identifies a directory."
 
        <category: 'testing'>
        self subclassResponsibility
@@ -462,6 +470,13 @@ size and timestamps.'>
        ^self class path: (File pathFor: self name ifNone: [ '.' ])
     ]
 
+    name [
+       "Answer the full path to the receiver"
+
+       <category: 'file name management'>
+       self subclassResponsibility
+    ]
+
     path [
        "Answer the path (if any) of the receiver"
 
@@ -658,21 +673,21 @@ size and timestamps.'>
         ^(self at: aName) exists
     ]
 
+    all [
+       "Return a decorator of the receiver that will provide recursive
+        descent into directories for iteration methods."
+
+       <category: 'decoration'>
+       ^Kernel.RecursiveFileWrapper on: self
+    ]
+
     allFilesMatching: aPattern do: aBlock [
        "Evaluate aBlock on the File objects that match aPattern (according to
         String>>#match:) in the directory named by the receiver. Recursively
         descend into directories."
 
        <category: 'enumerating'>
-       self namesDo: 
-               [:name | 
-               | f |
-               f := self at: name.
-               (aPattern match: name) ifTrue: [aBlock value: f].
-               f isDirectory 
-                   ifTrue: 
-                       [((#('.' '..') includes: name) or: [f isSymbolicLink]) 
-                           ifFalse: [f allFilesMatching: aPattern do: aBlock]]]
+       self all filesMatching: aPattern do: aBlock
     ]
 
     files [
@@ -792,6 +807,6 @@ size and timestamps.'>
 
        <category: 'enumerating'>
        self namesDo: [:name |
-            (aPattern match: name) ifTrue: [block value: (self nameAt: name)]]
+            (aPattern match: name) ifTrue: [block value: name]]
     ]
 ]
diff --git a/kernel/VFS.st b/kernel/VFS.st
index b1ee48b..af8dd38 100644
--- a/kernel/VFS.st
+++ b/kernel/VFS.st
@@ -76,11 +76,17 @@ virtual files that refer to a real file on disk.'>
     ]
 
     asString [
-       "Answer the container file containing me."
+       "Answer the string representation of the receiver's path."
        <category: 'accessing'>
        ^self file asString
     ]
 
+    name [
+       "Answer the full path to the receiver."
+       <category: 'accessing'>
+       ^self file name
+    ]
+
     isAbsolute [
         "Answer whether the receiver identifies an absolute path."
 
@@ -95,6 +101,20 @@ virtual files that refer to a real file on disk.'>
        ^self class on: self file full
     ]
 
+    mode [
+       "Answer the permission bits for the file identified by the receiver"
+
+       <category: 'delegation'>
+       ^self file mode
+    ]
+
+    mode: anInteger [
+       "Answer the permission bits for the file identified by the receiver"
+
+       <category: 'delegation'>
+       self file mode: anInteger
+    ]
+
     size [
        "Answer the size of the file identified by the receiver"
 
@@ -109,6 +129,77 @@ virtual files that refer to a real file on disk.'>
        ^self file lastAccessTime
     ]
 
+    exists [
+        "Answer whether a file with the name contained in the receiver
+        does exist."
+
+        <category: 'testing'>
+        ^self file exists
+    ]
+
+    isAbsolute [
+        "Answer whether the receiver identifies an absolute path."
+
+        <category: 'testing'>
+        ^self file isAbsolute
+    ]
+
+    isReadable [
+        "Answer whether a file with the name contained in the receiver does 
exist
+         and is readable"
+
+        <category: 'testing'>
+        ^self file isReadable
+    ]
+
+    isWriteable [
+        "Answer whether a file with the name contained in the receiver does 
exist
+         and is writeable"
+
+        <category: 'testing'>
+        ^self file isWriteable
+    ]
+
+    isExecutable [
+        "Answer whether a file with the name contained in the receiver does 
exist
+         and is executable"
+
+        <category: 'testing'>
+        ^self file isExecutable
+    ]
+
+    isAccessible [
+        "Answer whether a directory with the name contained in the receiver 
does
+         exist and can be accessed"
+
+        <category: 'testing'>
+        ^self file isAccessible
+    ]
+
+    isDirectory [
+        "Answer whether a file with the name contained in the receiver
+        does exist identifies a directory."
+
+        <category: 'testing'>
+        ^self file isDirectory
+    ]
+
+    isSymbolicLink [
+        "Answer whether a file with the name contained in the receiver
+        does exist and identifies a symbolic link."
+
+        <category: 'testing'>
+        ^self file isSymbolicLink
+    ]
+
+    lastAccessTime: accessDateTime lastModifyTime: modifyDateTime [
+        "Update the timestamps of the file corresponding to the receiver, to be
+         accessDateTime and modifyDateTime."
+
+        <category: 'accessing'>
+        self file lastAccessTime: accessDateTime lastModifyTime: modifyDateTime
+    ]
+
     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
@@ -179,6 +270,59 @@ virtual files that refer to a real file on disk.'>
        self file remove
     ]
 
+    symlinkAs: destName [
+        "Create destName as a symbolic link of the receiver.  The appropriate
+         relative path is computed automatically."
+
+        <category: 'file operations'>
+        ^self file symlinkAs: destName
+    ]
+
+    pathFrom: dirName [
+        "Compute the relative path from the directory dirName to the receiver"
+
+        <category: 'file operations'>
+        ^self file pathFrom: dirName
+    ]
+
+    symlinkFrom: srcName [
+        "Create the receiver as a symbolic link from srcName (relative to the
+         path of the receiver)."
+
+        <category: 'file operations'>
+        ^self file symlinkFrom: srcName
+    ]
+
+    renameTo: newName [
+        "Rename the file identified by the receiver to newName"
+
+        <category: 'file operations'>
+        ^self file renameTo: newName
+    ]
+
+    pathTo: destName [
+        "Compute the relative path from the receiver to destName."
+
+        <category: 'accessing'>
+        ^self file pathTo: destName
+    ]
+
+    at: aName [
+        "Answer a File or Directory object as appropriate for a file named
+         'aName' in the directory represented by the receiver."
+
+        <category: 'accessing'>
+        ^self class on: (self file at: aName)
+    ]
+
+    namesDo: aBlock [
+        "Evaluate aBlock once for each file in the directory represented by the
+         receiver, passing its name."
+
+        <category: 'enumerating'>
+        self file namesDo: aBlock
+    ]
+
     file [
        <category: 'private'>
        ^file
@@ -193,6 +337,55 @@ virtual files that refer to a real file on disk.'>
 ]
 
 
+Namespace current: Kernel [
+
+VFS.FileWrapper subclass: RecursiveFileWrapper [
+
+     do: aBlock [
+       "Same as the wrapped #do:, but reuses the file object for efficiency."
+
+       <category: 'enumerating'>
+        self file namesDo: 
+                [:name |
+                | f fullName |
+                f := self at: name. 
+                aBlock value: f.
+                f isDirectory 
+                    ifTrue:
+                        [((#('.' '..') includes: name) or: [f isSymbolicLink])
+                            ifFalse: [f do: aBlock]]]
+     ]
+
+     namesDo: aBlock prefixLength: anInteger [
+       "Same as the wrapped #namesDo:, but navigates the entire directory
+        tree recursively.  Since the objects created by #at: also contain the
+        path to the receiver, anInteger is used to trim it."
+
+       <category: 'private'>
+        self file namesDo: 
+                [:name |
+                | f fullName |
+                f := self at: name. 
+                aBlock value: (f asString copyFrom: anInteger).
+                f isDirectory 
+                    ifTrue:
+                        [((#('.' '..') includes: name) or: [f isSymbolicLink])
+                            ifFalse: [f
+                               namesDo: aBlock
+                               prefixLength: anInteger ]]]
+     ]
+
+     namesDo: aBlock [
+       "Same as the wrapped #namesDo:, but navigates the entire directory
+        tree recursively."
+
+       <category: 'enumerating'>
+        self namesDo: aBlock prefixLength: self asString size + 2
+     ]
+]
+
+]
+
 Namespace current: VFS [
 
 FileWrapper subclass: ArchiveFile [