Attachment "449531.diff.2" to
ticket [449531ffff]
added by
andreas_kupries
2001-08-22 02:17:13.
Index: Makefile.in
===================================================================
RCS file: /cvsroot/tcllib/tcllib/Makefile.in,v
retrieving revision 1.46
diff -u -r1.46 Makefile.in
--- Makefile.in 2001/08/20 22:30:54 1.46
+++ Makefile.in 2001/08/21 19:15:24
@@ -262,6 +262,17 @@
zip -r tcllib$(VERSION).zip tcllib$(VERSION)
rm -rf $(srcdir)/tcllib$(VERSION)
+# Check tcllib and report all modules without documentation and/or testsuite.
+check:
+ for mod in `ls $(srcdir)/modules | grep -v CVS`; do \
+ if [ `ls $(srcdir)/modules/$$mod/*.test 2>/dev/null | wc -l` -lt 1 ]; then \
+ echo ' ' $$mod has no testsuite; \
+ fi; \
+ if [ `ls $(srcdir)/modules/$$mod/*.[13n] 2>/dev/null | wc -l` -lt 1 ]; then \
+ echo ' ' $$mod has no manpages; \
+ fi; \
+ done
+
#========================================================================
# End of user-definable section
#========================================================================
Index: modules/fileutil/ChangeLog
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/fileutil/ChangeLog,v
retrieving revision 1.5
diff -u -r1.5 ChangeLog
--- modules/fileutil/ChangeLog 2001/07/31 23:47:51 1.5
+++ modules/fileutil/ChangeLog 2001/08/21 19:15:24
@@ -1,6 +1,27 @@
+2001-08-21 Andreas Kupries <[email protected]>
+
+ * All of the changes below are related to tcllib Patch [449531] by
+ Anselm Lingnau <[email protected]>. Instead of
+ taking in the proposed highlevel 'fileinput' I added some of the
+ more low-level commands from Tclx which can be used to
+ create/compose 'fileinput'.
+
+ * pkgIndex.tcl: Moved version of fileutil to 1.2.
+
+ * fileutil.test: Added tests for the new commands. Moved version
+ of fileutil to 1.2.
+
+ * fileutil.n: Added documentation of the new commands. Moved
+ version of fileutil to 1.2.
+
+ * fileutil.tcl (findByPattern, foreachLine): New commands, modeled
+ after TclX's 'recursive_glob' and 'for_file'. Moved version of
+ fileutil to 1.2.
+
2001-07-31 Andreas Kupries <[email protected]>
- * fileutil.n: Added manpage [446584].
+ * fileutil.n: Added manpage documenting the commands. tcllib Bug
+ [446584].
2001-06-21 Andreas Kupries <[email protected]>
Index: modules/fileutil/fileutil.n
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/fileutil/fileutil.n,v
retrieving revision 1.3
diff -u -r1.3 fileutil.n
--- modules/fileutil/fileutil.n 2001/08/02 16:38:06 1.3
+++ modules/fileutil/fileutil.n 2001/08/21 19:15:24
@@ -13,26 +13,26 @@
.SH SYNOPSIS
\fBpackage require Tcl 8\fR
.sp
-\fBpackage require fileutil ?1.1?\fR
+\fBpackage require fileutil ?1.2?\fR
.sp
-\fB::fileutil::grep\fR \fIpattern\fR ?\fIfiles\fR?
+\fB::fileutil::cat\fR \fIfilename\fR
.sp
\fB::fileutil::find\fR ?\fIbasedir\fR ?\fIfiltercmd\fR??
.sp
-\fB::fileutil::cat\fR \fIfilename\fR
+\fB::fileutil::findByPattern\fR \fIbasedir\fR ?\fI-regexp\fI|\fI-glob\fR? ?\fI\--\fR? \fIpatterns\fR
+.sp
+\fB::fileutil::foreachLine\fR \fIvar filename cmd\fR
+.sp
+\fB::fileutil::grep\fR \fIpattern\fR ?\fIfiles\fR?
.BE
.SH DESCRIPTION
.PP
This package provides implementations of standard unix utilities
.TP
-\fB::fileutil::grep\fR \fIpattern\fR ?\fIfiles\fR?
-Implementation of grep. Adapted from the Tcler's Wiki. The first
-argument defines the \fIpattern\fR to search for. This is followed by
-a list of \fIfiles\fR to search through. The list is optional and
-\fBstdin\fR will be used if is missing. The result of the procedures
-is a list containing the matches. Each match is a single element of
-the list and contains filename, number and contents of the matching
-line, separated by a colons.
+\fB::fileutil::cat\fR \fIfilename\fR
+A tcl implementation of the UNIX "cat" command. Returns the contents
+of the specified file. The first argument is the name of the file to
+read.
.TP
\fB::fileutil::find\fR ?\fIbasedir\fR ?\fIfiltercmd\fR??
An implementation of the unix command \fBfind\fR. Adapted from the
@@ -45,10 +45,36 @@
The result of the command is a list containing the paths to the
interesting files.
.TP
-\fB::fileutil::cat\fR \fIfilename\fR
-A tcl implementation of the UNIX "cat" command. Returns the contents
-of the specified file. The first argument is the name of the file to
-read.
+\fB::fileutil::findByPattern\fR \fIbasedir\fR ?\fI-regexp\fI|\fI-glob\fR? ?\fI\--\fR? \fIpatterns\fR
+This command is based upon the TclX command \fBrecursive_glob\fR,
+except that it doesn't allow recursion over more than one directory at
+a time. It uses \fB::fileutil::find\fR internally and is thus able to
+and does follow symbolic links, something the TclX command does not
+do. First argument is the directory to start the search in, second
+argument is a list of \fIpatterns\fR. The command returns a list of
+all files reachable through \fIbasedir\fR whose names match at least
+one of the patterns. The options before the pattern-list determine the
+style of matching, either regexp or glob. glob-style matching is the
+default if no options are given. Usage of the option \fI--\fR stops
+option processing. This allows the use of a leading '-' in the
+patterns.
+.TP
+\fB::fileutil::foreachLine\fR \fIvar filename cmd\fR
+The command reads the file \fIfilename\fR and executes the script
+\fIcmd\fR for every line in the file. During the execution of the
+script the variable \fIvar\fR is set to the contents of the current
+line. The return value of this command is the result of the last
+invocation of the script \fIcmd\fR or the empty string if the file was
+empty.
+.TP
+\fB::fileutil::grep\fR \fIpattern\fR ?\fIfiles\fR?
+Implementation of grep. Adapted from the Tcler's Wiki. The first
+argument defines the \fIpattern\fR to search for. This is followed by
+a list of \fIfiles\fR to search through. The list is optional and
+\fBstdin\fR will be used if is missing. The result of the procedures
+is a list containing the matches. Each match is a single element of
+the list and contains filename, number and contents of the matching
+line, separated by a colons.
.SH KEYWORDS
file utilities
Index: modules/fileutil/fileutil.tcl
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/fileutil/fileutil.tcl,v
retrieving revision 1.7
diff -u -r1.7 fileutil.tcl
--- modules/fileutil/fileutil.tcl 2001/08/02 16:38:06 1.7
+++ modules/fileutil/fileutil.tcl 2001/08/21 19:15:24
@@ -10,7 +10,7 @@
# RCS: @(#) $Id: fileutil.tcl,v 1.7 2001/08/02 16:38:06 andreas_kupries Exp $
package require Tcl 8
-package provide fileutil 1.1
+package provide fileutil 1.2
namespace eval ::fileutil {
namespace export *
@@ -178,8 +178,95 @@
cd $oldwd
return $files
}
+
+ # end if
+}
+
+# ::fileutil::findByPattern --
+#
+# Specialization of find. Finds files based on their names,
+# which have to match the specified patterns. Options are used
+# to specify which type of patterns (regexp-, glob-style) is
+# used.
+#
+# Arguments:
+# basedir Directory to start searching from.
+# args Options (-glob, -regexp, --) followed by a
+# list of patterns to search for.
+#
+# Results:
+# files a list of interesting files.
+
+proc ::fileutil::findByPattern {basedir args} {
+ set pos 0
+ set cmd ::fileutil::FindGlob
+ foreach a $args {
+ incr pos
+ switch -glob -- $a {
+ -- {break}
+ -regexp {set cmd ::fileutil::FindRegexp}
+ -glob {set cmd ::fileutil::FindGlob}
+ -* {return -code error "Unknown option $a"}
+ default {incr pos -1 ; break}
+ }
+ }
+
+ set args [lrange $args $pos end]
+
+ if {[llength $args] != 1} {
+ set pname [lindex [info level 0] 0]
+ return -code error \
+ "wrong#args for \"$pname\", should be\
+ \"$pname basedir ?-regexp|-glob? ?--? patterns\""
+ }
+
+ set patterns [lindex $args 0]
+ return [find $basedir [list $cmd $patterns]]
}
+
+# ::fileutil::FindRegexp --
+#
+# Internal helper. Filter command used by 'findByPattern'
+# to match files based on regular expressions.
+#
+# Arguments:
+# patterns List of regular expressions to match against.
+# filename Name of the file to match against the patterns.
+# Results:
+# interesting A boolean flag. Set to true if the file
+# matches at least one of the patterns.
+
+proc ::fileutil::FindRegexp {patterns filename} {
+ foreach p $patterns {
+ if {[regexp -- $p $filename]} {
+ return 1
+ }
+ }
+ return 0
+}
+
+# ::fileutil::FindGlob --
+#
+# Internal helper. Filter command used by 'findByPattern'
+# to match files based on glob expressions.
+#
+# Arguments:
+# patterns List of glob expressions to match against.
+# filename Name of the file to match against the patterns.
+# Results:
+# interesting A boolean flag. Set to true if the file
+# matches at least one of the patterns.
+
+proc ::fileutil::FindGlob {patterns filename} {
+ foreach p $patterns {
+ if {[string match $p $filename]} {
+ return 1
+ }
+ }
+ return 0
+}
+
# ::fileutil::cat --
#
# Tcl implementation of the UNIX "cat" command. Returns the contents
@@ -201,3 +288,43 @@
return $data
}
+# ::fileutil::foreachLine --
+#
+# Executes a script for every line in a file.
+#
+# Arguments:
+# var name of the variable to contain the lines
+# filename name of the file to read.
+# cmd The script to execute.
+#
+# Results:
+# None.
+
+proc ::fileutil::foreachLine {var filename cmd} {
+ upvar 1 $var line
+ set fp [open $filename r]
+
+ # -future- Use try/eval from tcllib/control
+ catch {
+ set code 0
+ set result {}
+ while {[gets $fp line] >= 0} {
+ set code [catch {uplevel 1 $cmd} result]
+ if {($code != 0) && ($code != 4)} {break}
+ }
+ }
+ close $fp
+
+ if {($code == 0) || ($code == 3) || ($code == 4)} {
+ return $result
+ }
+ if {$code == 1} {
+ global errorCode errorInfo
+ return \
+ -code $code \
+ -errorcode $errorCode \
+ -errorinfo $errorInfo \
+ $result
+ }
+ return -code $code $result
+}
Index: modules/fileutil/fileutil.test
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/fileutil/fileutil.test,v
retrieving revision 1.4
diff -u -r1.4 fileutil.test
--- modules/fileutil/fileutil.test 2001/03/26 16:50:21 1.4
+++ modules/fileutil/fileutil.test 2001/08/21 19:15:24
@@ -75,6 +75,27 @@
[file join $dir find1 find2 file2]]
+# find by pattern tests
+
+test find-2.0 {find by pattern} {
+ catch {::fileutil::findByPattern $dir -glob {fil*} foo} msg
+ set msg
+} {wrong#args for "::fileutil::findByPattern", should be "::fileutil::findByPattern basedir ?-regexp|-glob? ?--? patterns"}
+
+test find-2.1 {find by pattern} {
+ catch {::fileutil::findByPattern $dir -glob} msg
+ set msg
+} {wrong#args for "::fileutil::findByPattern", should be "::fileutil::findByPattern basedir ?-regexp|-glob? ?--? patterns"}
+
+test find-2.2 {find by pattern} {
+ lsort [::fileutil::findByPattern $dir -glob {fil*}]
+} [list [file join $dir find1 file1] [file join $dir find1 find2 file2]]
+
+test find-2.3 {find by pattern} {
+ lsort [::fileutil::findByPattern $dir -regexp {.*1$}]
+} [list [file join $dir find1] [file join $dir find1 file1]]
+
+
catch {removeDirectory grepTest} ; # start with a clean structure!
# Build a sample tree to search
@@ -98,6 +119,15 @@
test cat-1.1 {cat} {
fileutil::cat [file join $dir catTest file1]
} "foo\nbar\nbaz\n"
+
+
+test foreachline-1.0 {foreachLine} {
+ set res ""
+ ::fileutil::foreachLine line [file join $dir catTest file1] {
+ append res /$line
+ }
+ set res
+} {/foo/bar/baz}
::tcltest::cleanupTests
return
Index: modules/fileutil/pkgIndex.tcl
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/fileutil/pkgIndex.tcl,v
retrieving revision 1.3
diff -u -r1.3 pkgIndex.tcl
--- modules/fileutil/pkgIndex.tcl 2001/08/02 16:38:06 1.3
+++ modules/fileutil/pkgIndex.tcl 2001/08/21 19:15:24
@@ -9,4 +9,4 @@
# full path name of this file's directory.
if {![package vsatisfies [package provide Tcl] 8]} {return}
-package ifneeded fileutil 1.1 [list source [file join $dir fileutil.tcl]]
+package ifneeded fileutil 1.2 [list source [file join $dir fileutil.tcl]]
