From af98fafabfa1a6d22688ff491fea63155665f2e5 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Thu, 15 Dec 2011 23:32:24 +0100 Subject: [PATCH] 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. --- doc/ref/misc-modules.texi | 19 +++++++++++++++---- module/ice-9/ftw.scm | 38 ++++++++++++++++++++------------------ 2 files changed, 35 insertions(+), 22 deletions(-) diff --git a/doc/ref/misc-modules.texi b/doc/ref/misc-modules.texi index ee124899a..617762441 100644 --- 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 539d80b5f..a25412138 100644 --- 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