[PATCH] RecursiveFileWrapper

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  <[hidden email]>

        * 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 [

_______________________________________________
help-smalltalk mailing list
[hidden email]
http://lists.gnu.org/mailman/listinfo/help-smalltalk