ftw: Add an optional `stat' parameter to `file-system-fold' and `-tree'.

* module/ice-9/ftw.scm (file-system-fold): Add an optional `stat'
  parameter.  Use it instead of `lstat'.  Handle the case where (STAT child)
  fails.
  (file-system-tree): Likewise, and pass it to `file-system-fold'.

* doc/ref/misc-modules.texi (File Tree Walk): Update the documentation
  of these functions.

diff --git a/doc/ref/misc-modules.texi b/doc/ref/misc-modules.texi
index ee12489..6177624 100644 (file)
--- a/doc/ref/misc-modules.texi
+++ b/doc/ref/misc-modules.texi
@@ -1098,6 +1098,9 @@ try to use one of them.  The reason for two versions is that the full
 @section File Tree Walk
 @cindex file tree walk
 
+@cindex file system traversal
+@cindex directory traversal
+
 The functions in this section traverse a tree of files and
 directories.  They come in two flavors: the first one is a high-level
 functional interface, and the second one is similar to the C @code{ftw}
@@ -1109,9 +1112,9 @@ GNU C Library Reference Manual}).
 @end example
 @sp 1
 
-@defun file-system-tree file-name [enter?]
+@defun file-system-tree file-name [enter? [stat]]
 Return a tree of the form @code{(@var{file-name} @var{stat}
-@var{children} ...)} where @var{stat} is the result of @code{(lstat
+@var{children} ...)} where @var{stat} is the result of @code{(@var{stat}
 @var{file-name})} and @var{children} are similar structures for each
 file contained in @var{file-name} when it designates a directory.
 
@@ -1121,6 +1124,9 @@ directory @var{name}; the default value is a procedure that always
 returns @code{#t}.  When a directory does not match @var{enter?}, it
 nonetheless appears in the resulting tree, only with zero children.
 
+The @var{stat} argument is optional and defaults to @code{lstat}, as for
+@code{file-system-fold} (see below.)
+
 The example below shows how to obtain a hierarchical listing of the
 files under the @file{module/language} directory in the Guile source
 tree, discarding their @code{stat} info:
@@ -1174,7 +1180,7 @@ than building up a tree of entries in memory, like
 directly as a directory tree is traversed; in fact,
 @code{file-system-tree} is implemented in terms of it.
 
-@defun file-system-fold enter? leaf down up skip init file-name
+@defun file-system-fold enter? leaf down up skip init file-name [stat]
 Traverse the directory at @var{file-name}, recursively, and return the
 result of the successive applications of the @var{leaf}, @var{down},
 @var{up}, and @var{skip} procedures as described below.
@@ -1183,7 +1189,7 @@ Enter sub-directories only when @code{(@var{enter?} @var{path}
 @var{stat} @var{result})} returns true.  When a sub-directory is
 entered, call @code{(@var{down} @var{path} @var{stat} @var{result})},
 where @var{path} is the path of the sub-directory and @var{stat} the
-result of @code{(false-if-exception (lstat @var{path}))}; when it is
+result of @code{(false-if-exception (@var{stat} @var{path}))}; when it is
 left, call @code{(@var{up} @var{path} @var{stat} @var{result})}.
 
 For each file in a directory, call @code{(@var{leaf} @var{path}
@@ -1203,6 +1209,11 @@ file name, then @var{path} is also an absolute file name.  Files and
 directories, as identified by their device/inode number pair, are
 traversed only once.
 
+The optional @var{stat} argument defaults to @code{lstat}, which means
+that symbolic links are not followed; the @code{stat} procedure can be
+used instead when symbolic links are to be followed (@pxref{File System,
+stat}).
+
 The example below illustrates the use of @code{file-system-fold}:
 
 @example

diff --git a/module/ice-9/ftw.scm b/module/ice-9/ftw.scm
index 539d80b..a254121 100644 (file)
--- a/module/ice-9/ftw.scm
+++ b/module/ice-9/ftw.scm
@@ -387,15 +387,17 @@
 ;;; `file-system-fold' & co.
 ;;;
 
-(define (file-system-fold enter? leaf down up skip init file-name)
+(define* (file-system-fold enter? leaf down up skip init file-name
+                           #:optional (stat lstat))
   "Traverse the directory at FILE-NAME, recursively.  Enter
 sub-directories only when (ENTER? PATH STAT RESULT) returns true.  When
 a sub-directory is entered, call (DOWN PATH STAT RESULT), where PATH is
-the path of the sub-directory and STAT the result of (lstat PATH); when
+the path of the sub-directory and STAT the result of (stat PATH); when
 it is left, call (UP PATH STAT RESULT).  For each file in a directory,
 call (LEAF PATH STAT RESULT).  When ENTER? returns false, call (SKIP
 PATH STAT RESULT).  Return the result of these successive applications.
-When FILE-NAME names a flat file,(LEAF PATH STAT INIT) is returned."
+When FILE-NAME names a flat file, (LEAF PATH STAT INIT) is returned.
+The optional STAT parameter defaults to `lstat'."
 
   (define (mark v s)
     (vhash-cons (cons (stat:dev s) (stat:ino s)) #t v))
@@ -405,7 +407,7 @@ When FILE-NAME names a flat file,(LEAF PATH STAT INIT) is returned."
 
   (let loop ((name     file-name)
              (path     "")
-             (dir-stat (false-if-exception (lstat file-name)))
+             (dir-stat (false-if-exception (stat file-name)))
              (result   init)
              (visited  vlist-null))
 
@@ -452,16 +454,14 @@ When FILE-NAME names a flat file,(LEAF PATH STAT INIT) is returned."
                                subdirs))
                         (else
                          (let* ((child (string-append full-name "/" entry))
-                                (stat  (lstat child))) ; cannot fail
-                           (cond
-                            ((eq? (stat:type stat) 'directory)
-                             (liip (readdir dir)
-                                   result
-                                   (alist-cons entry stat subdirs)))
-                            (else
-                             (liip (readdir dir)
-                                   (leaf child stat result)
-                                   subdirs)))))))
+                                (st    (false-if-exception (stat child))))
+                           (if (and stat (eq? (stat:type st) 'directory))
+                               (liip (readdir dir)
+                                     result
+                                     (alist-cons entry st subdirs))
+                               (liip (readdir dir)
+                                     (leaf child st result)
+                                     subdirs))))))
 
                 ;; Directory FULL-NAME not readable.
                 ;; XXX: It's up to the user to distinguish between not
@@ -474,15 +474,17 @@ When FILE-NAME names a flat file,(LEAF PATH STAT INIT) is returned."
       ;; Caller passed a FILE-NAME that names a flat file, not a directory.
       (leaf full-name dir-stat result)))))
 
-(define* (file-system-tree file-name #:optional (enter? (lambda (n s) #t)))
+(define* (file-system-tree file-name
+                           #:optional (enter? (lambda (n s) #t))
+                                      (stat lstat))
   "Return a tree of the form (FILE-NAME STAT CHILDREN ...) where STAT is
-the result of (lstat FILE-NAME) and CHILDREN are similar structures for
+the result of (stat FILE-NAME) and CHILDREN are similar structures for
 each file contained in FILE-NAME when it designates a directory.  The
 optional ENTER? predicate is invoked as (ENTER? NAME STAT) and should
 return true to allow recursion into directory NAME; the default value is
 a procedure that always returns #t.  When a directory does not match
 ENTER?, it nonetheless appears in the resulting tree, only with zero
-children."
+children.  The optional STAT parameter defaults to `lstat'."
   (define (enter?* name stat result)
     (enter? name stat))
   (define (leaf name stat result)
@@ -501,6 +503,6 @@ children."
   (define skip                   ; keep an entry for skipped directories
     leaf)
 
-  (caar (file-system-fold enter?* leaf down up skip '(()) file-name)))
+  (caar (file-system-fold enter?* leaf down up skip '(()) file-name stat)))
 
 ;;; ftw.scm ends here