;;;; ftw.scm --- filesystem tree walk
-;;;; Copyright (C) 2002 Free Software Foundation, Inc.
+;;;; Copyright (C) 2002, 2003, 2006 Free Software Foundation, Inc.
;;;;
-;;;; This program is free software; you can redistribute it and/or modify
-;;;; it under the terms of the GNU General Public License as published by
-;;;; the Free Software Foundation; either version 2, or (at your option)
-;;;; any later version.
-;;;;
-;;;; This program is distributed in the hope that it will be useful,
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 2.1 of the License, or (at your option) any later version.
+;;;;
+;;;; This library is distributed in the hope that it will be useful,
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;;;; GNU General Public License for more details.
-;;;;
-;;;; You should have received a copy of the GNU General Public License
-;;;; along with this software; see the file COPYING. If not, write to
-;;;; the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
-;;;; Boston, MA 02111-1307 USA
-;;;;
-;;;; As a special exception, the Free Software Foundation gives permission
-;;;; for additional uses of the text contained in its release of GUILE.
-;;;;
-;;;; The exception is that, if you link the GUILE library with other files
-;;;; to produce an executable, this does not by itself cause the
-;;;; resulting executable to be covered by the GNU General Public License.
-;;;; Your use of that executable is in no way restricted on account of
-;;;; linking the GUILE library code into it.
-;;;;
-;;;; This exception does not however invalidate any other reasons why
-;;;; the executable file might be covered by the GNU General Public License.
-;;;;
-;;;; This exception applies only to the code released by the
-;;;; Free Software Foundation under the name GUILE. If you copy
-;;;; code from other Free Software Foundation releases into a copy of
-;;;; GUILE, as the General Public License permits, the exception does
-;;;; not apply to the code that you add in this way. To avoid misleading
-;;;; anyone as to the status of such modified files, you must delete
-;;;; this exception notice from them.
-;;;;
-;;;; If you write modifications of your own for GUILE, it is your choice
-;;;; whether to permit this exception to apply to your modifications.
-;;;; If you do not wish that, delete this exception notice.
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;;;; Lesser General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
;;; Author: Thien-Thi Nguyen <ttn@gnu.org>
(let loop ((new (readdir dir-stream))
(acc '()))
(if (eof-object? new)
- acc
+ (begin
+ (closedir dir-stream)
+ acc)
(loop (readdir dir-stream)
(if (or (string=? "." new) ;;; ignore
(string=? ".." new)) ;;; ignore
(define (abs? filename)
(char=? #\/ (string-ref filename 0)))
+;; `visited?-proc' returns a test procedure VISITED? which when called as
+;; (VISITED? stat-obj) returns #f the first time a distinct file is seen,
+;; then #t on any subsequent sighting of it.
+;;
+;; stat:dev and stat:ino together uniquely identify a file (see "Attribute
+;; Meanings" in the glibc manual). Often there'll be just one dev, and
+;; usually there's just a handful mounted, so the strategy here is a small
+;; hash table indexed by dev, containing hash tables indexed by ino.
+;;
+;; It'd be possible to make a pair (dev . ino) and use that as the key to a
+;; single hash table. It'd use an extra pair for every file visited, but
+;; might be a little faster if it meant less scheme code.
+;;
(define (visited?-proc size)
- (let ((visited (make-hash-table size)))
+ (let ((dev-hash (make-hash-table 7)))
(lambda (s)
- (and s (let ((ino (stat:ino s)))
- (or (hash-ref visited ino)
- (begin
- (hash-set! visited ino #t)
- #f)))))))
+ (and s
+ (let ((ino-hash (hashv-ref dev-hash (stat:dev s)))
+ (ino (stat:ino s)))
+ (or ino-hash
+ (begin
+ (set! ino-hash (make-hash-table size))
+ (hashv-set! dev-hash (stat:dev s) ino-hash)))
+ (or (hashv-ref ino-hash ino)
+ (begin
+ (hashv-set! ino-hash ino #t)
+ #f)))))))
(define (stat-dir-readable?-proc uid gid)
(let ((uid (getuid))
HCoop / bpt / guile.git / blobdiff