Attachment "fileutil.patch" to
ticket [2250870fff]
added by
glehner
2008-11-10 03:05:17.
Index: ChangeLog
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/fileutil/ChangeLog,v
retrieving revision 1.115
diff -u -r1.115 ChangeLog
--- ChangeLog 17 Oct 2008 05:32:35 -0000 1.115
+++ ChangeLog 9 Nov 2008 18:11:26 -0000
@@ -1,13 +1,24 @@
+2008-11-09 Georg Lehner <[email protected]>
+
+ * traverse.tcl: Added options -notroot, -sort, -order and the
+ * traverse.man: method basedir. Allows traversal without
+ including the basedir, sorting before traversing and resetting
+ the basedir of a traverser object. This required changes to the
+ Init method and to the next method (order).
+ Also: fixed error handling in the next method to comply with the
+ man page. An error while globbing files or directories now
+ invokes the errorcmd handler, or is ignored.
+
2008-10-16 1.11 <[email protected]>
*
* Released and tagged Tcllib 1.11 ========================
- *
+ *
2008-10-10 Andreas Kupries <[email protected]>
* multiop.test: Canonicalized sorting of two test results.
- * multi.test:
+ * multi.test:
2008-09-03 Andreas Kupries <[email protected]>
Index: pkgIndex.tcl
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/fileutil/pkgIndex.tcl,v
retrieving revision 1.32
diff -u -r1.32 pkgIndex.tcl
--- pkgIndex.tcl 4 Sep 2008 02:24:47 -0000 1.32
+++ pkgIndex.tcl 7 Nov 2008 18:10:01 -0000
@@ -2,7 +2,7 @@
package ifneeded fileutil 1.13.4 [list source [file join $dir fileutil.tcl]]
if {![package vsatisfies [package provide Tcl] 8.3]} {return}
-package ifneeded fileutil::traverse 0.4 [list source [file join $dir traverse.tcl]]
+package ifneeded fileutil::traverse 0.5 [list source [file join $dir traverse.tcl]]
if {![package vsatisfies [package provide Tcl] 8.4]} {return}
package ifneeded fileutil::multi 0.1 [list source [file join $dir multi.tcl]]
Index: traverse.man
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/fileutil/traverse.man,v
retrieving revision 1.3
diff -u -r1.3 traverse.man
--- traverse.man 24 Oct 2007 19:28:36 -0000 1.3
+++ traverse.man 9 Nov 2008 18:42:00 -0000
@@ -1,9 +1,9 @@
[comment {-*- text -*- doctools manpage}]
-[manpage_begin fileutil_traverse n 0.4]
+[manpage_begin fileutil_traverse n 0.5]
[moddesc {file utilities}]
[titledesc {Iterative directory traversal}]
[require Tcl 8.3]
-[require fileutil::traverse [opt 0.4]]
+[require fileutil::traverse [opt 0.5]]
[description]
[keywords {directory traversal} traversal]
[para]
@@ -83,6 +83,12 @@
able to incrementally traverse a directory hierarchy in an event-based
manner.
+[call [cmd \$traverser] [method basedir] [arg path]]
+
+This method (re)sets the basedir of the traverser. In some cases it may
+be desired to re-use a traverser on different directories.
+
+
[list_end]
@@ -119,6 +125,25 @@
to the caller, i.e. however invoked the [method next]. Any other
results from the callback are ignored.
+[opt_def "-notroot boolean"]
+
+By default, the base (or root) directory of the traverser is included
+in the iteration. If [opt "-notroot [const True]"] is given, the traverser
+will not include the root, but rather start with the content of the root.
+
+[opt_def "-sort collation_order"]
+
+Before traversing a directory, it is sorted by [const collation_order].
+Allowed values are [const ascii] and [const dictionary] and an empty string,
+which indicates no sorting. The collation is done by [cmd lsort].
+
+[opt_def -order direction]
+
+This options allows to specify the direction of ordering ff [opt -sort]
+is given a non-empty string. Allowed values are [const increasing], which
+is the default, and [const decreasing].
+
+
[list_end]
Index: traverse.tcl
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/fileutil/traverse.tcl,v
retrieving revision 1.6
diff -u -r1.6 traverse.tcl
--- traverse.tcl 28 Feb 2008 07:11:34 -0000 1.6
+++ traverse.tcl 8 Nov 2008 07:46:50 -0000
@@ -22,6 +22,8 @@
}
package require control ; # Helpers for control structures
+package require fileutil ; # Helpers for file access
+
snit::type ::fileutil::traverse {
# Incremental directory traversal.
@@ -31,11 +33,16 @@
# next filevar -> boolean
# foreach filevar script
# files -> list (path ...)
+ # basedir path -> set new basedirectory
# Options
# -prefilter command-prefix
# -filter command-prefix
# -errorcmd command-prefix
+ # -notroot boolean
+ # -sort {}|ascii|dictionary -> do lsort on each directory
+ # unless sort is empty
+ # -order increasing|decreasing -> order of lsort
# Use cases
#
@@ -81,7 +88,7 @@
# but allowed to pass to the caller, usually of 'next'.
# Note: Low-level functionality, version and platform dependent is
- # implemented in procedures, and conditioally defined for optimal
+ # implemented in procedures, and conditionally defined for optimal
# use of features, etc. ...
# Note: Traversal is done in depth-first pre-order.
@@ -96,6 +103,13 @@
option -filter -default {} -readonly 1
option -prefilter -default {} -readonly 1
option -errorcmd -default {} -readonly 1
+ option -notroot -default false -readonly 1 -type {snit::boolean}
+ option -sort -default {} -readonly 1 -type {
+ snit::enum -values {{} ascii dictionary }
+ }
+ option -order -default increasing -readonly 1 -type {
+ snit::enum -values {increasing decreasing}
+ }
constructor {basedir args} {
set _base $basedir
@@ -103,6 +117,11 @@
return
}
+ method basedir path {
+ set _base $path
+ $self Init
+ }
+
method files {} {
set files {}
$self foreach f {lappend files $f}
@@ -158,8 +177,8 @@
# next one.
if {[llength $_results]} {
- set top [lindex $_results end]
- set _results [lreplace $_results end end]
+ set top [lindex $_results 0]
+ set _results [lrange $_results 1 end]
set currentfile $top
return 1
}
@@ -173,8 +192,8 @@
# the result stack contains at least one path we can return.
while {[llength $_pending]} {
- set top [lindex $_pending end]
- set _pending [lreplace $_pending end end]
+ set top [lindex $_pending 0]
+ set _pending [lrange $_pending 1 end]
# Directory accessible? Skip if not.
if {![ACCESS $top]} {
@@ -185,7 +204,16 @@
# Expand the result stack with all files in the directory,
# modulo filtering.
- foreach f [GLOBF $top] {
+ set code [catch {GLOBF $top} files]
+ if {$code} {Error $top $files; continue}
+
+ if {[llength $options(-sort)]} {
+ set files [lsort -$options(-sort) \
+ -$options(-order) \
+ $files]
+ }
+
+ foreach f $files {
if {![Valid $f]} continue
lappend _results $f
}
@@ -195,7 +223,16 @@
# processing stack with the same directories, if not seen
# yet and modulo pre-filtering.
- foreach f [GLOBD $top] {
+ set code [catch {GLOBD $top} dirs]
+ if {$code} {Error $top $dirs; continue}
+ if {[llength $options(-sort)]} {
+ set dirs [lsort -$options(-sort) \
+ -$options(-order) \
+ $dirs]
+ }
+
+ foreach f $dirs {
+ # LEG:Note: unix specific
if {
[string equal [file tail $f] "."] ||
[string equal [file tail $f] ".."]
@@ -217,8 +254,8 @@
# Stop expanding if we have paths to return.
if {[llength $_results]} {
- set top [lindex $_results end]
- set _results [lreplace $_results end end]
+ set top [lindex $_results 0]
+ set _results [lrange $_results 1 end]
set currentfile $top
return 1
}
@@ -252,13 +289,23 @@
## Internal helpers.
method Init {} {
- # Path ok as result?
- if {[Valid $_base]} {
+
+ # do away with with not-directory start values
+ if {[Valid $_base] && ![file isdirectory $_base]} {
lappend _results $_base
+ set _init 1
+ return
}
- # Expansion allowed by prefilter?
- if {[file isdirectory $_base] && [Recurse $_base]} {
+ # from here we deal with a directory
+ # Path ok as result?
+ if !{$options(-notroot)} {
+ lappend _results $_base
+
+ # Expansion allowed by prefilter?
+ if {[Recurse $_base]} {lappend _pending $_base}
+ } else {
+ # -notroot: inconditional traversal of base
lappend _pending $_base
}
@@ -414,4 +461,4 @@
# ### ### ### ######### ######### #########
## Ready
-package provide fileutil::traverse 0.4
+package provide fileutil::traverse 0.5
