1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 11:40:18 +02:00

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.
This commit is contained in:
Ludovic Courtès 2011-12-15 23:32:24 +01:00
parent ed4c373966
commit af98fafabf
2 changed files with 35 additions and 22 deletions

View file

@ -1098,6 +1098,9 @@ try to use one of them. The reason for two versions is that the full
@section File Tree Walk @section File Tree Walk
@cindex 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 The functions in this section traverse a tree of files and
directories. They come in two flavors: the first one is a high-level 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} functional interface, and the second one is similar to the C @code{ftw}
@ -1109,9 +1112,9 @@ GNU C Library Reference Manual}).
@end example @end example
@sp 1 @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} 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 @var{file-name})} and @var{children} are similar structures for each
file contained in @var{file-name} when it designates a directory. 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 returns @code{#t}. When a directory does not match @var{enter?}, it
nonetheless appears in the resulting tree, only with zero children. 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 The example below shows how to obtain a hierarchical listing of the
files under the @file{module/language} directory in the Guile source files under the @file{module/language} directory in the Guile source
tree, discarding their @code{stat} info: 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, directly as a directory tree is traversed; in fact,
@code{file-system-tree} is implemented in terms of it. @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 Traverse the directory at @var{file-name}, recursively, and return the
result of the successive applications of the @var{leaf}, @var{down}, result of the successive applications of the @var{leaf}, @var{down},
@var{up}, and @var{skip} procedures as described below. @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 @var{stat} @var{result})} returns true. When a sub-directory is
entered, call @code{(@var{down} @var{path} @var{stat} @var{result})}, 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 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})}. left, call @code{(@var{up} @var{path} @var{stat} @var{result})}.
For each file in a directory, call @code{(@var{leaf} @var{path} 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 directories, as identified by their device/inode number pair, are
traversed only once. 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}: The example below illustrates the use of @code{file-system-fold}:
@example @example

View file

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